Các câu hỏi về mảng trong VBA (Array)

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,023
Được thích
393
Điểm
235
Nơi ở
Hà Nội
Cảm ơn Bác Siwtom và Snow25 đã giúp đỡ.
Đúng như Bác Siwtom đã góp ý bài này có rất nhiều lúc ngược lúc xuôi lúc 2 mã, lúc 3 mã giống nhau... rất nhiều điều kiện (khá rắc rối)
Vì vậy mà OT đã chọn hướng đi khác đi khác rồi ạ.
Chúc Bác & Bạn nhiều sức khỏe.
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,207
Được thích
1,982
Điểm
360
Xin chào các bạn,
Nhờ các bạn giúp OT đỡ trường hợp trong tập tin gửi kèm với ạ.
Bạn chạy thử sub này nhé.
Mã:
Sub chuyen()
Dim arr, arr1, lr As Long, i As Long, a As Long, j As Long
With Sheet1
    lr = .Range("D" & Rows.Count).End(xlUp).Row
    arr = .Range("D3:aj" & lr).Value
    ReDim arr1(1 To UBound(arr, 1) * 31, 1 To 4)
End With
   For i = 1 To UBound(arr, 1)
       For j = 3 To UBound(arr, 2)
           If arr(i, j) <> Empty Then
              a = a + 1
              arr1(a, 1) = arr(i, 1)
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = j - 2
              arr1(a, 4) = arr(i, j)
           End If
       Next j
   Next i
With Sheet2
      lr = .Range("C" & Rows.Count).End(xlUp).Row
      If lr > 2 Then .Range("C3:F" & lr).ClearContents
      If a Then .Range("c3").Resize(a, 4).Value = arr1
End With
End Sub
 

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,023
Được thích
393
Điểm
235
Nơi ở
Hà Nội
Bạn chạy thử sub này nhé.
Mã:
Sub chuyen()
Dim arr, arr1, lr As Long, i As Long, a As Long, j As Long
With Sheet1
    lr = .Range("D" & Rows.Count).End(xlUp).Row
    arr = .Range("D3:aj" & lr).Value
    ReDim arr1(1 To UBound(arr, 1) * 31, 1 To 4)
End With
   For i = 1 To UBound(arr, 1)
       For j = 3 To UBound(arr, 2)
           If arr(i, j) <> Empty Then
              a = a + 1
              arr1(a, 1) = arr(i, 1)
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = j - 2
              arr1(a, 4) = arr(i, j)
           End If
       Next j
   Next i
With Sheet2
      lr = .Range("C" & Rows.Count).End(xlUp).Row
      If lr > 2 Then .Range("C3:F" & lr).ClearContents
      If a Then .Range("c3").Resize(a, 4).Value = arr1
End With
End Sub
Xin cảm ơn Snow25 rất nhiều, kết quả đúng ý OT rồi ạ.
 

quyenpv

Thành viên thường trực
Tham gia ngày
5 Tháng một 2013
Bài viết
330
Được thích
31
Điểm
385
Tuổi
36
Với bài toán này các anh xem giúp dùng mảng có trị được không ạ
Hiện em đang phải thực hiện các bước sau để đưa dữ liệu vào 2 Sheet
1. Lấy thủ công số phiếu, ngày xuất vật tư đưa vào Sheet Input_TB cột AS, AT, AU
2. Lấy số lượng, đơn giá vật tư đưa vào Sheet Input_TB theo bảng
3. Căn cứ vào vật tư đã lấy vào Sheet Input_TB đưa sang Sheet BQT_VTU
+ Nếu xuất hiện bao nhiêu lần trong phiếu xuất sẽ có bấy nhiêu dòng bên BQT_VTU
+ Lấy số phiếu, số lượng vật tư, đơn giá tương ứng từ Sheet Input_TB qua Sheet BQT_VTU

Topic nhờ giúp
 

File đính kèm

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
92
Được thích
5
Điểm
370
Em có viết 1 đoạn VBA để tổng hợp bảng kê ra bảng tổng hợp tuy nhiên code sử dụng lại chạy chưa đúng !. anh (chị) sửa lỗi sai giúp em với ạ !
Mã:
Sub TongHop2()
 Dim Data As Variant, Arr(1 To 65536, 1 To 6), i As Long, TenKh As String, j As Long, k As Long
 Data = Sheet2.Range("A2:F15").Value
 If UBound(Data) = 1 Then Exit Sub
    For i = 1 To UBound(Data)
   If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
    If TypeName(Data(i, 1)) = "Double" Then
      k = k + 1
      Arr(k, 1) = TenKh
      Arr(k, 2) = Data(i + 1, 1)
      Arr(k, 3) = Data(i + 1, 2)
      Arr(k, 4) = Data(i + 1, 3)
      Arr(k, 5) = Data(i + 1, 4)
      Arr(k, 6) = Data(i + 1, 5)
    End If
    Next
If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr
End Sub
 

File đính kèm

leonguyenz

╠╗╦══╦╔╣
Thành viên BQT
Moderator
Tham gia ngày
2 Tháng tám 2010
Bài viết
4,335
Được thích
7,598
Điểm
610
Nơi ở
Bình Dương
Em có viết 1 đoạn VBA để tổng hợp bảng kê ra bảng tổng hợp tuy nhiên code sử dụng lại chạy chưa đúng !. anh (chị) sửa lỗi sai giúp em với ạ !
Mã:
Sub TongHop2()
Dim Data As Variant, Arr(1 To 65536, 1 To 6), i As Long, TenKh As String, j As Long, k As Long
Data = Sheet2.Range("A2:F15").Value
If UBound(Data) = 1 Then Exit Sub
    For i = 1 To UBound(Data)
   If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
    If TypeName(Data(i, 1)) = "Double" Then
      k = k + 1
      Arr(k, 1) = TenKh
      Arr(k, 2) = Data(i + 1, 1)
      Arr(k, 3) = Data(i + 1, 2)
      Arr(k, 4) = Data(i + 1, 3)
      Arr(k, 5) = Data(i + 1, 4)
      Arr(k, 6) = Data(i + 1, 5)
    End If
    Next
If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr
End Sub
Bạn xem file đính kèm
Mã:
Sub TongHop2()
Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
Data = Sheet2.Range("A2:F15").Value
ReDim Arr(1 To UBound(Data, 1), 1 To 7)
    For i = 1 To UBound(Data)
        If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
        If IsDate(Data(i, 1)) Then
            k = k + 1
            Arr(k, 1) = TenKh
            For j = 1 To 6
                Arr(k, j + 1) = Data(i, j)
            Next j
        End If
    Next i
If k Then
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Sheet2.Range("H2").Resize(k, 7).Value = Arr
End If
End Sub
 

File đính kèm

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
92
Được thích
5
Điểm
370
Bạn xem file đính kèm
Mã:
Sub TongHop2()
Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
Data = Sheet2.Range("A2:F15").Value
ReDim Arr(1 To UBound(Data, 1), 1 To 7)
    For i = 1 To UBound(Data)
        If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
        If IsDate(Data(i, 1)) Then
            k = k + 1
            Arr(k, 1) = TenKh
            For j = 1 To 6
                Arr(k, j + 1) = Data(i, j)
            Next j
        End If
    Next i
If k Then
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Sheet2.Range("H2").Resize(k, 7).Value = Arr
End If
End Sub
Dạ em cảm ơn anh ạ !
 

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
6,081
Được thích
10,072
Điểm
1,860
Các bạn chưa xóa dữ liệu trong lần chạy trước
Nếu trường hợp làn chạy sau có chỉ số K bé hơn lần trước thì kết quả sẽ là trời ơi!
 

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
92
Được thích
5
Điểm
370
Các bạn chưa xóa dữ liệu trong lần chạy trước
Nếu trường hợp làn chạy sau có chỉ số K bé hơn lần trước thì kết quả sẽ là trời ơi!
Dạ em chưa hiểu vấn đề của anh, anh có thể giải thích rõ hơn cho em 1 chút được không ạ !
 

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
6,081
Được thích
10,072
Điểm
1,860
Với câu lệnh này
If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr
Thì có thể có 2 trương hợp sẩy ra:

(1) Lần chạy macro lần trước K=9 (giả dụ)
Lần này chỉ có K=7
Vậy thì 2 dòng dữ liệu của lần chạy trước còn nguyên xi & bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu, thay vì 7

(2) Nếu lần chạy macro sau có số dòng bằng hoặc lớn hơn lần chạy trước thì bạn đã tiết kiệm được 1 dòng lệnh & không đán để được chúc mừng đâu!
 

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
92
Được thích
5
Điểm
370
Với câu lệnh này
If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr
Thì có thể có 2 trương hợp sẩy ra:

(1) Lần chạy macro lần trước K=9 (giả dụ)
Lần này chỉ có K=7
Vậy thì 2 dòng dữ liệu của lần chạy trước còn nguyên xi & bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu, thay vì 7

(2) Nếu lần chạy macro sau có số dòng bằng hoặc lớn hơn lần chạy trước thì bạn đã tiết kiệm được 1 dòng lệnh & không đán để được chúc mừng đâu!
Vậy có nghĩa là trước khi ghi dữ liệu sẽ xóa đi rồi câu lệnh đó là k >0 đúng không anh !
 

batman1

Thành viên gắn bó
Tham gia ngày
8 Tháng chín 2014
Bài viết
2,182
Được thích
3,384
Điểm
560
Các bạn chưa xóa dữ liệu trong lần chạy trước
...
(1) Lần chạy macro lần trước K=9 (giả dụ)
Lần này chỉ có K=7
Vậy thì 2 dòng dữ liệu của lần chạy trước còn nguyên xi & bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu, thay vì 7
Cái này không đúng. Vì nếu k = 7 thì có nghĩa là k > 0, tức dòng
Mã:
Sheet2.Range("H2").Resize(1000, 7).ClearContents
sẽ được thực hiện nên không có chuyện "bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu". Dòng trên là của leonguyenz mà bạn viết
Các bạn chưa xóa dữ liệu trong lần chạy trước
thì không đúng.

Tất nhiên phải xóa dữ liệu cũ nhưng lý do không phải là "Nếu trường hợp làn chạy sau có chỉ số K bé hơn lần trước thì kết quả sẽ là trời ơi!" mà là "Nếu trường hợp làn chạy sau có chỉ số K = 0 thì kết quả sẽ là trời ơi!". Tại sao? Vì khi k = 0 thì lẽ ra phải là không có kết quả nhưng do k = 0 nên code trong If k Then ... End If của leonguyenz không được thực hiện nên kết quả cũ không được xóa, và người ta hiểu lầm là vẫn có kết quả.

Code của leonguyenz có xóa kết quả cũ nhưng chưa chuẩn vì chỉ xóa khi k > 0 mà không xóa khi k = 0.

Lôgíc là: trước hết xóa kết quả cũ sau đó chạy code còn lại. Nếu sau đó không có dữ liệu thỏa điều kiện thì ắt hẳn k = 0 và lúc đó "vùng kết quả trắng tinh" (do trước đó vùng kết quả đã được xóa). Nếu sau đó k > 0 thì kết quả có bao nhiêu thì sẽ được nhập vào vùng kết quả bấy nhiêu, không thừa và cũng không thiếu, vừa vặn.

Tóm lại trong code của leonguyenz
- xóa dòng
Mã:
Sheet2.Range("H2").Resize(1000, 7).ClearContents
- trước dòng
Mã:
Data = Sheet2.Range("A2:F15").Value
thì thêm dòng
Mã:
Sheet2.Range("H2").Resize(1000, 7).ClearContents
Nói cách khác: hãy chuyển dòng
Mã:
Sheet2.Range("H2").Resize(1000, 7).ClearContents
lên đầu.

Nếu dữ liệu rất nhiều và có khả năng kết quả > 1000 thì sửa 1000 thành số "đủ lớn". Hoặc xác định dòng cuối cùng trong vùng kết quả cũ để xóa hết kết quả cũ.
 
Lần chỉnh sửa cuối:

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,023
Được thích
393
Điểm
235
Nơi ở
Hà Nội
Bạn xem file đính kèm
Mã:
Sub TongHop2()
Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
Data = Sheet2.Range("A2:F15").Value
ReDim Arr(1 To UBound(Data, 1), 1 To 7)
    For i = 1 To UBound(Data)
        If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
        If IsDate(Data(i, 1)) Then
            k = k + 1
            Arr(k, 1) = TenKh
            For j = 1 To 6
                Arr(k, j + 1) = Data(i, j)
            Next j
        End If
    Next i
If k Then
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Sheet2.Range("H2").Resize(k, 7).Value = Arr
End If
End Sub
Xin chào các bạn,
Với code trên của anh leonguyenz , Oanh Thơ đang thử loay hoay với cách sử dụng ReDim Preserve cho mảng Arr, sao cho chiều thứ nhất số phần thử trong mảng bằng k.
Nhưng chưa biết xử lý thế nào, code chạy toàn báo lỗi nhờ các bạn chỉ dẫn ạ :(
 

tam888

Thành viên tích cực
Tham gia ngày
22 Tháng tám 2013
Bài viết
840
Được thích
498
Điểm
435
Xin chào các bạn,
Với code trên của anh leonguyenz , Oanh Thơ đang thử loay hoay với cách sử dụng ReDim Preserve cho mảng Arr, sao cho chiều thứ nhất số phần thử trong mảng bằng k.
Nhưng chưa biết xử lý thế nào, code chạy toàn báo lỗi nhờ các bạn chỉ dẫn ạ :(
Với VBA: Redim Preserve chỉ cho thay đổi chiều cuối của mảng, tức là mảng 2 chiều thì cho thay đổi theo chiều thứ 2 (cột) của mảng . Nên theo k là không thể
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,086
Được thích
8,322
Điểm
560
...cách sử dụng ReDim Preserve cho mảng Arr, sao cho chiều thứ nhất số phần thử trong mảng bằng k.
Nhưng chưa biết xử lý thế nào, code chạy toàn báo lỗi nhờ các bạn chỉ dẫn ạ :(
Lại "chạy toàn báo lỗi" !!! Lỗi gì? Ở dòng nào?

Mảng 2 chiều phải không? Chịu khó tìm, vấn đề này và các cách giải quyết đã từng được bàn qua rồi.
 

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,023
Được thích
393
Điểm
235
Nơi ở
Hà Nội
Xin chào tam888, Bác VetMini,
Cảm ơn mọi người đã giúp đỡ Oanh Thơ ạ.

Lại "chạy toàn báo lỗi" !!! Lỗi gì? Ở dòng nào?
Mảng 2 chiều phải không? Chịu khó tìm, vấn đề này và các cách giải quyết đã từng được bàn qua rồi.
Híc, con xin lỗi Bác con quên mất ..
nó bị lỗi "Subscript out of range" tại dòng ReDim Preserve Arr(1 To k, 1 To 7)
Nhờ Bác chỉ dẫn thêm cho ạ.

Mã:
Sub TongHop2()
    Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Data = Sheet2.Range("A2:F15").Value
    ReDim Arr(1 To UBound(Data, 1), 1 To 7)
        For i = 1 To UBound(Data)
            If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
            If IsDate(Data(i, 1)) Then
                k = k + 1
                ReDim Preserve Arr(1 To k, 1 To 7)
                Arr(k, 1) = TenKh
                For j = 1 To 6
                    Arr(k, j + 1) = Data(i, j)
                Next j
            End If
        Next i
    If k Then
        Sheet2.Range("H2").Resize(k, 7).Value = Arr
    End If
End Sub
 

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
2,207
Được thích
1,982
Điểm
360
Xin chào tam888, Bác VetMini,
Cảm ơn mọi người đã giúp đỡ Oanh Thơ ạ.



Híc, con xin lỗi Bác con quên mất ..
nó bị lỗi "Subscript out of range" tại dòng ReDim Preserve Arr(1 To k, 1 To 7)
Nhờ Bác chỉ dẫn thêm cho ạ.

Mã:
Sub TongHop2()
    Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Data = Sheet2.Range("A2:F15").Value
    ReDim Arr(1 To UBound(Data, 1), 1 To 7)
        For i = 1 To UBound(Data)
            If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
            If IsDate(Data(i, 1)) Then
                k = k + 1
                ReDim Preserve Arr(1 To k, 1 To 7)
                Arr(k, 1) = TenKh
                For j = 1 To 6
                    Arr(k, j + 1) = Data(i, j)
                Next j
            End If
        Next i
    If k Then
        Sheet2.Range("H2").Resize(k, 7).Value = Arr
    End If
End Sub
Bỏ dòng đó đi là được.
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,086
Được thích
8,322
Điểm
560
Đã nói vấn đề này đã được bàn qua rồi mà.
Cách làm căn bản là đổi dòng thành cột, cột thành dòng

1. Nếu mảng nhỏ: dùng hàm transpose và/hoặc index
Vì dùng hàm Worksheet cho nên chỉ dùng được tới vài ngàn dòng.

2. Nếu mảng lớn: tự viết một hàm chuyển.
 

Nguyễn Hoàng Oanh Thơ

Thành viên tích cực
Tham gia ngày
5 Tháng mười một 2015
Bài viết
1,023
Được thích
393
Điểm
235
Nơi ở
Hà Nội
Bỏ dòng đó đi là được.
Hi cảm ơn snow25 đã hỗ trợ.
Mục đích OT chỉ là tìm hiểu thêm về "ReDim Preserve" làm sao để thay đổi kích thước mảng vừa đủ ứng với số phần tử thỏa mãn cần xuất ra ạ. :)

Đã nói vấn đề này đã được bàn qua rồi mà.
Cách làm căn bản là đổi dòng thành cột, cột thành dòng

1. Nếu mảng nhỏ: dùng hàm transpose và/hoặc index
Vì dùng hàm Worksheet cho nên chỉ dùng được tới vài ngàn dòng.

2. Nếu mảng lớn: tự viết một hàm chuyển.
Dạ, Bác biết link nào bàn chi tiết cho những người "ngu lâu, chậm hiểu" như con có khả năng tiếp thu được chút ít thì Bác chỉ cho con với ạ :D
 
Top Bottom