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

Liên hệ QC
viehoai

viehoai

Thành viên gắn bó
Tham gia
22/5/09
Bài viết
2,600
Được thích
2,907
Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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.
 
Upvote 0
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 ạ.
 

File đính kèm

  • Book3.xlsx
    26.8 KB · Đọc: 32
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
snow25 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Xin cảm ơn Snow25 rất nhiều, kết quả đúng ý OT rồi ạ.
 
Upvote 0
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

  • Help_4A.xlsm
    114.6 KB · Đọc: 6
Upvote 0
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

  • HoiGpe.xlsm
    15.4 KB · Đọc: 9
Upvote 0
vanvan9697 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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

  • HoiGpe.xlsm
    15 KB · Đọc: 17
Upvote 0
leonguyenz đã viết:
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
Nhấp chuột vào đây để mở rộng...
Dạ em cảm ơn anh ạ !
 
Upvote 0
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!
 
Upvote 0
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!
 
Upvote 0
SA_DQ đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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 !
 
Upvote 0
SA_DQ đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
Nhấp chuột vào đây để mở rộng...
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:
Upvote 0
leonguyenz đã viết:
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
Nhấp chuột vào đây để mở rộng...

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 ạ :(
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
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 ạ :(
Nhấp chuột vào đây để mở rộng...
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ể
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
...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 ạ :(
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
Xin chào tam888, Bác VetMini,
Cảm ơn mọi người đã giúp đỡ Oanh Thơ ạ.

VetMini đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bỏ dòng đó đi là được.
 
Upvote 0
Đã 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.
 
Upvote 0
snow25 đã viết:
Bỏ dòng đó đi là được.
Nhấp chuột vào đây để mở rộng...
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 ạ. :)

VetMini đã viết:
Đã 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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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

H
Nhờ hướng dẫn chuyển hàng thành cột và dữ liệu theo nhu cầu bằng VBA
Trả lời
1
Đọc
47
DeTong
D
H
  • Question
Code VBA cho kết quả dòng, cột theo điều kiện từ 2 Sheets
Trả lời
2
Đọc
71
SA_DQ
SA_DQ
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
2
Đọc
61
NguyenthiH
NguyenthiH
T
Cần giúp sao chép C1 từ B1
Trả lời
3
Đọc
82
tle2003
T
A
Tìm số nhỏ nhất, số lớn nhất theo ngày
Trả lời
6
Đọc
76
hoangtuaotrang_hp_vn
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

Back
Top Bottom