Chuyển mảng đa chiều về một chiều theo hình xoắn ốc bằng VBA (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
S

sakutara1505

Thành viên mới
Tham gia
15/4/12
Bài viết
11
Được thích
2
Chào các anh chị trên diễn đàn em có 1 vấn đề khó khăn mà loay hoay mãi ko giải được vì dữ liệu rất lớn mà làm thủ công thi không biết ngày tháng năm nào mới xong được, mong anh chị trên diễn đàn giúp đỡ, vấn đề là em có:
Ma trận : [TABLE="width: 330"]
[TR]
[TD="align: right"][TABLE="width: 165"]
[TR]
[TD="align: right"]13[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]58[/TD]
[TD="align: right"]73[/TD]
[/TR]
[TR]
[TD="align: right"]14[/TD]
[TD="align: right"]29[/TD]
[TD="align: right"]44[/TD]
[TD="align: right"]59[/TD]
[TD="align: right"]74[/TD]
[/TR]
[TR]
[TD="align: right"]15[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]45[/TD]
[TD="align: right"]60[/TD]
[TD="align: right"]75
[/TD]
[/TR]
[/TABLE]
[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[/TABLE]
Em muốn đưa nó về mảng 1 chiều theo hình xoắn ốc như sau: (em muốn chuyển theo cột dọc nhưng sợ dài bài quá nên em viết kết quả theo hàng)
13 14 15 30 29 28 43 44 45 60 59 58 73 74 75

Mong được anh chị diễn đàn giúp đỡ!
 
sakutara1505 đã viết:
Chào các anh chị trên diễn đàn em có 1 vấn đề khó khăn mà loay hoay mãi ko giải được vì dữ liệu rất lớn mà làm thủ công thi không biết ngày tháng năm nào mới xong được, mong anh chị trên diễn đàn giúp đỡ, vấn đề là em có:
Ma trận : [TABLE="width: 330"]
[TR]
[TD="align: right"][TABLE="width: 165"]
[TR]
[TD="align: right"]13[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]58[/TD]
[TD="align: right"]73[/TD]
[/TR]
[TR]
[TD="align: right"]14[/TD]
[TD="align: right"]29[/TD]
[TD="align: right"]44[/TD]
[TD="align: right"]59[/TD]
[TD="align: right"]74[/TD]
[/TR]
[TR]
[TD="align: right"]15[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]45[/TD]
[TD="align: right"]60[/TD]
[TD="align: right"]75[/TD]
[/TR]
[/TABLE]
[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[/TABLE]
Em muốn đưa nó về mảng 1 chiều theo hình xoắn ốc như sau: (em muốn chuyển theo cột dọc nhưng sợ dài bài quá nên em viết kết quả theo hàng)
13 14 15 30 29 28 43 44 45 60 59 58 73 74 75

Mong được anh chị diễn đàn giúp đỡ!
Nhấp chuột vào đây để mở rộng...
Cái này là chuyển mảng 2 chiều sang mảng 1 chiều chứ? đâu phải là mảng đa chiều( mảng đa chiều là mảng nhiều hơn một chiều, có thể là 2 chiều, 3 chiều, 4 chiều và ... n chiều) đâu
Code cục bộ tham khảo chơi
Mã: 
Sub ABC()
Dim Arr2()
Dim Arr1(1 To 15)
Dim i As Long, j As Long
Dim K As Long
Arr2 = Sheet1.Range("A1:E3")
For j = 1 To 5
  For i = 1 To 3
    K = K + 1
   If (j Mod 2 = 1) Then
      Arr1(K) = Arr2(i, j)
    Else
      Arr1(K) = Arr2(3 - i + 1, j)
    End If
Next
Next
End Sub
 
Lần chỉnh sửa cuối:
Dạ, em đang ví dụ vậy, anh giúp em chuyển như trên ví dụ được không ạ?
 
sakutara1505 đã viết:
Chào các anh chị trên diễn đàn em có 1 vấn đề khó khăn mà loay hoay mãi ko giải được vì dữ liệu rất lớn mà làm thủ công thi không biết ngày tháng năm nào mới xong được, mong anh chị trên diễn đàn giúp đỡ, vấn đề là em có:
Ma trận : [TABLE="width: 330"]
[TR]
[TD="align: right"][TABLE="width: 165"]
[TR]
[TD="align: right"]13[/TD]
[TD="align: right"]28[/TD]
[TD="align: right"]43[/TD]
[TD="align: right"]58[/TD]
[TD="align: right"]73[/TD]
[/TR]
[TR]
[TD="align: right"]14[/TD]
[TD="align: right"]29[/TD]
[TD="align: right"]44[/TD]
[TD="align: right"]59[/TD]
[TD="align: right"]74[/TD]
[/TR]
[TR]
[TD="align: right"]15[/TD]
[TD="align: right"]30[/TD]
[TD="align: right"]45[/TD]
[TD="align: right"]60[/TD]
[TD="align: right"]75[/TD]
[/TR]
[/TABLE]
[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[/TABLE]
Em muốn đưa nó về mảng 1 chiều theo hình xoắn ốc như sau: (em muốn chuyển theo cột dọc nhưng sợ dài bài quá nên em viết kết quả theo hàng)
13 14 15 30 29 28 43 44 45 60 59 58 73 74 75

Mong được anh chị diễn đàn giúp đỡ!
Nhấp chuột vào đây để mở rộng...

Với mảng dữ liệu bắt đầu tại sheet1[A1]
Kết quả điền vào sheet2
Mã: 
Public Sub sakutara()
Dim DArr, Res, r, c, i

DArr = Sheet1.Range("A1").CurrentRegion
ReDim Res(1 To UBound(DArr) * UBound(DArr, 2), 1 To 1)

For c = 1 To UBound(DArr, 2)
If c Mod 2 = 1 Then
For r = 1 To UBound(DArr)
i = i + 1
Res(i, 1) = DArr(r, c)
Next r
Else
For r = UBound(DArr) To 1 Step -1
i = i + 1
Res(i, 1) = DArr(r, c)
Next r
End If
Next c
Sheet2.UsedRange.ClearContents
Sheet2.Range("A1").Resize(UBound(Res), 1) = Res
End Sub
 
TheThienChu đã viết:
Với mảng dữ liệu bắt đầu tại sheet1[A1]
Kết quả điền vào sheet2
Mã: 
Public Sub sakutara()
Dim DArr, Res, r, c, i

DArr = Sheet1.Range("A1").CurrentRegion
ReDim Res(1 To UBound(DArr) * UBound(DArr, 2), 1 To 1)

For c = 1 To UBound(DArr, 2)
If c Mod 2 = 1 Then
For r = 1 To UBound(DArr)
i = i + 1
Res(i, 1) = DArr(r, c)
Next r
Else
For r = UBound(DArr) To 1 Step -1
i = i + 1
Res(i, 1) = DArr(r, c)
Next r
End If
Next c
Sheet2.UsedRange.ClearContents
Sheet2.Range("A1").Resize(UBound(Res), 1) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Tuyệt vời! Đúng ý em rồi, cảm ơn anh nhiều! Chúc anh năm mới gặp nhiều may mắn trong cuộc sống
 
Đúng rồi đấy anh phihndhsp ạ! Em cảm ơn anh nhiều, chúc anh năm mới gặp nhiều may mắn
 
phihndhsp đã viết:
Cái này là chuyển mảng 2 chiều sang mảng 1 chiều chứ? đâu phải là mảng đa chiều( mảng đa chiều là mảng nhiều hơn một chiều, có thể là 2 chiều, 3 chiều, 4 chiều và ... n chiều) đâu
Code cục bộ tham khảo chơi
Mã: 
Sub ABC()
Dim Arr2()
Dim Arr1(1 To 15)
Dim i As Long, j As Long
Dim K As Long
Arr2 = Sheet1.Range("A1:E3")
For j = 1 To 5
  For i = 1 To 3
    K = K + 1
   If (j Mod 2 = 1) Then
      Arr1(K) = Arr2(i, j)
    Else
      Arr1(K) = Arr2(3 - i + 1, j)
    End If
Next
Next
End Sub
Nhấp chuột vào đây để mở rộng...

Chủ thớt nói "xoắn ốc" nhưng thực ra là hình "rắn bò"
Bài này đáng ra bạn có thể tìm một công thức chuyển đổi để chiếu (map) giữa hai tập hợp. Khi đó bạn chỉ phải mất 1 vòng lặp

Redim MangKQ(1 to Ubound(MangNguon)*Ubound(MangNguon,2))
For i = 1 to UBound(MangKQ)
MangKQ(i) = MangNguon(CongThucDong(i), CongThucCot(i))
Next i

Đối với dân dạy lập trình như bạn, đây là con toán xứng đáng nghiên cứu
 
VetMini đã viết:
Chủ thớt nói "xoắn ốc" nhưng thực ra là hình "rắn bò"
Bài này đáng ra bạn có thể tìm một công thức chuyển đổi để chiếu (map) giữa hai tập hợp. Khi đó bạn chỉ phải mất 1 vòng lặp

Redim MangKQ(1 to Ubound(MangNguon)*Ubound(MangNguon,2))
For i = 1 to UBound(MangKQ)
MangKQ(i) = MangNguon(CongThucDong(i), CongThucCot(i))
Next i

Đối với dân dạy lập trình như bạn, đây là con toán xứng đáng nghiên cứu
Nhấp chuột vào đây để mở rộng...
Có phải anh muốn em tính toán số dòng và số cột trực tiếp trên mảng 2 chiều rồi gán lại vào mảng một chiều ?
Mã: 
Sub ABC()
Dim Arr2()
Dim Arr1(1 To 15)
Dim dong As Long, j As Long, cot As Long
Arr2 = Sheet1.Range("A1:E3")
For j = 1 To 15
    cot = Int((j - 1) / 3) + 1
    dong = (j - 1) Mod 3 + 1
    If cot Mod 2 = 0 Then
      dong = 3 - dong + 1
    End If
       Arr1(j) = Arr2(dong, cot)
  Next
Sheet1.Range("G1").Resize(15, 1) = Application.Transpose(Arr1)
End Sub
 
Lần chỉnh sửa cuối:
Đại khái là vậy. Nhưng đó là trường hợp chung.

Đây là loại con toán thực hiện theo vòng lặp tuần tự, cho nên có những giá trị tính theo dạng tuần tự sẽ dễ hơn.

row = 1: col = 1: mov = 1 ' mov là chiều chạy của row
for i = 1 to mxrow*mxcol
kq(i) = dv(row, col)
row = row + mov ' dòng kế tiếp
if row < 1 or row > mxrow then ' hết 1 cột
col = col + 1 ' sang cột kế tiếp
mov = -mov ' đổi chiều
row = row + mov ' khởi đầu cột kế tiếp
end if
next i
' mánh khoé bài này nằm ở chỗ dùng hẳn hòi 1 biến để theo chỉ định chiều chạy của dòng
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

N
Khắc phục lỗi "The picture is too large and will be truncated" (1 người xem)
Trả lời
10
Đọc
5K
tle2003
T
C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt
Trả lời
4
Đọc
130
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
G
Xin Code xóa Module.
Trả lời
8
Đọc
273
huhumalu
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup (1 người xem)
Trả lời
3
Đọc
147
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
22
Đọc
545
nguyendang95
N
S
Mở 2 cửa sổ riêng biệt
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
138
lamvu0677
L
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (1 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
1
Đọc
123
khkkh
K
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
798
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
228
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
0
Đọc
148
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo (1 người xem)
Trả lời
1
Đọc
138
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
14
Đọc
224
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
712
thuytrangbp28
T
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
241
Hoàng Tuấn 868
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom