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

viehoai · 24/3/11

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ị

befaint · 18/10/17

chitbk đã viết:
cần làm trên chạy code tren VBA

Thử đoạn sau:

PHP:

Function GetRowColumnArray2D(ByVal arSrc, ByVal index As Long, Optional ByVal GetRow As Boolean = True)
''arSrc: Mang 2 chieu
''index: Chi so dong hoac cot can lay du lieu
''GetRow: Mac dinh lay theo dong, nguoc lai =False thi lay theo cot
    Dim Result(), i As Long, j As Long, d As Long
    d = IIf(GetRow = True, 2, 1)
    For i = LBound(arSrc, d) To UBound(arSrc, d)
        If GetRow = True Then
            ReDim Preserve Result(j)
            Result(j) = arSrc(index, i)
            j = j + 1
        Else
            ReDim Preserve Result(j)
            Result(j) = arSrc(i, index)
            j = j + 1
        End If
    Next i
    GetRowColumnArray2D = Result
End Function

NguyenNgocThuHien · 18/10/17

befaint đã viết:
Không được. Bạn thử đi...

Mã:

Sub kk()
    Dim c
    Dim a(1 To 3, 1 To 3) As Variant
    Dim i, j
    Dim k
    For i = LBound(a, 2) To UBound(a, 2)
        For j = LBound(a, 1) To UBound(a, 1)
            
            
            k = k + 1
            a(j, i) = k
        Next
    Next
    Range("a1:c3").Value = a
    c = Application.Index(a, 2) 'hang 2
    
    Range("d1:f1").Value = c
    c = Application.Index(a, , 3) 'cot 3
    Range("h1:h3").Value = c
End Sub

Đối với cột thì có thể dùng api, nhưng chưa thử.

befaint · 18/10/17

NguyenNgocThuHien đã viết:
c = Application.Index(a, 2) 'hang 2

Kết quả là mảng 1 chiều.

NguyenNgocThuHien đã viết:
c = Application.Index(a, , 3) 'cot 3

Kết quả là mảng 2 chiều. Thử thêm Transpose vào được không?

NguyenNgocThuHien đã viết:
Đối với cột thì có thể dùng api

Vậy ta làm luôn đi.

tueyennhi · 19/10/17

em có mảng sau KHR(r1, 1) = HR(i, 2)

'(1)
Range("A5")= KHR(r1, 1)

Làm thế nào để biến cái "dọc" này thành ngang??

Giả sử kết quả mảng đó có các phần tử tại dòng 1, 2 và 3 là 10, 11 và 12, cột là cột 1. Vậy làm thế nào để chuyển hóa cái "dòng dọc" này thành dòng "ngang"?

Hay nói cách khác em muốn kết quả thể hiện tại 1(1) lần lượt là :A5 là 10, A6 là 11 và A7 là 12

NguyenNgocThuHien · 19/10/17

befaint đã viết:
Kết quả là mảng 1 chiều.

Kết quả là mảng 2 chiều. Thử thêm Transpose vào được không?

Vậy ta làm luôn đi.

Mã:

 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Sub kk()
    Dim c
    Dim a(1 To 3, 1 To 3) As Variant
    Dim kq() As Variant
    
    
    
    
    Dim i, j
    Dim k
    For i = LBound(a, 2) To UBound(a, 2)
        For j = LBound(a, 1) To UBound(a, 1)
            
            
            k = k + 1
            a(j, i) = k
        Next
    Next
    Range("a1:c3").Value = a
    c = Application.Index(a, 2) 'hang 2
    
    ReDim kq(1 To 3)
    
    'CopyMemory kq(1), c(1, 1), 16 * 3&
    
    Range("d1:f1").Value = c
    c = Application.Index(a, , 3) 'cot 3
    CopyMemory kq(1), c(1, 1), 16 * 3&
    
    Range("h1:h3").Value = kq
End Sub

anhtuanle123 · 20/10/17

hàm CopyMemory hay đó , có thể dùng nó như kiểu con trỏ đến bộ nhớ trong c vậy !^^

tueyennhi · 27/11/17

Anh chị giúp em với, file rõ ràng không có phần tử nào trong mảng mà khi chạy code trong file nó báo đến tận dòng 1048572.

ndu96081631 · 27/11/17

tueyennhi đã viết:
Anh chị giúp em với, file rõ ràng không có phần tử nào trong mảng mà khi chạy code trong file nó báo đến tận dòng 1048572.

Từ dòng 5 trở đi có dữ liệu đâu? Vì thế mà Range("B5").End(xlDown)) sẽ nằm ở dòng thứ 1048576

tueyennhi · 27/11/17

ndu96081631 đã viết:
Từ dòng 5 trở đi có dữ liệu đâu? Vì thế mà Range("B5").End(xlDown)) sẽ nằm ở dòng thứ 1048576

À như vậy ít nhất em phải có dữ liệu ở B5 và B6. Cảm ơn thầy nhé!

ndu96081631 · 27/11/17

tueyennhi đã viết:
À như vậy ít nhất em phải có dữ liệu ở B5 và B6. Cảm ơn thầy nhé!

Thường để an toàn ít ai dùng End(xlDown) mà nên End(xlUp) cho chắc

Hoang2013 · 27/11/17

Nên xài End(xlDown) trong các trường hợp CSDL hợp chuẩn & tất nhiên trong nhiều trường hợp sẽ nhanh hơn là End(xlUp)

tueyennhi · 28/11/17

Xem giúp em code này sai ở đâu với. Điều kiện là tại ô check nếu không có dữ liệu thì điền ID vào cột ID và giá trị "N" vào ngày tương ứng sang sheet Chinh. Em kiểm tra rất kỹ rồi mà không tài nào phát hiện ra cái sai.

tueyennhi · 28/11/17

hpkhuong đã viết:
dArr(1 To 10000, 1 To 35) -> 35 cột
sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value -> 125 cột

J chạy từ cột 2 tới cột cuối của mảng sArr (tức 125)

==> Mảng dArr bị té ghế

À vậy em sửa lại như sau:

PHP:

Public Sub Loc_nghi()
Dim dic As Object, Ws As Worksheet, Tem As String, Rws As Long
Dim i As Long, j As Long, K As Long, C As Long
Dim sArr(), dArr(1 To 20000, 1 To 2000)
sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
For i = 3 To UBound(sArr, 1)
    For j = 2 To 117 Step 4
        If Weekday(sArr(1, j)) <> 1 Then
            If IsEmpty(sArr(i, j)) Then
                K = K + 1
                dArr(K, 1) = sArr(i, 1)
                dArr(K, K + 1) = "N"
            End If
        End If
    Next j
Next i
Sheets("Chinh").Range("A2").Resize(K, 32) = dArr
End Sub

Mà vẫn không được

tueyennhi · 28/11/17

hpkhuong đã viết:
Túm lại đừng vội vàng... Ông bà ta nói "Chưa học bò chớ lo học chạy". Tìm hiểu về vòng lặp, Step rồi hỡ phát biểu...

Ôi anh ơi giúp em với em đang check công mà làm thủ công lâu quá nên vội lên diễn đàn hỏi. Điều kiện của em muốn lọc những ai không có công, có các dữ liệu nghỉ (ô trống tại cột công các ngày) thì chuyển sang sheet Chính là N (Nghỉ không lý do).

Em hiểu là cái K của em đang có vấn đề vì mỗi vòng lặp j thỏa mãn thì K + 1. Như vậy kết quả có ra thì cũng thành một dãy ID trùng nhau nhưng em chưa biết đặt K ở đâu cho đúng. Mong mọi người giúp đỡ!

Gió Đông · 28/11/17

tueyennhi đã viết:

À vậy em sửa lại như sau:

PHP:

Public Sub Loc_nghi()
Dim dic As Object, Ws As Worksheet, Tem As String, Rws As Long
Dim i As Long, j As Long, K As Long, C As Long
Dim sArr(), dArr(1 To 20000, 1 To 2000)
sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
For i = 3 To UBound(sArr, 1)
    For j = 2 To 117 Step 4
        If Weekday(sArr(1, j)) <> 1 Then
            If IsEmpty(sArr(i, j)) Then
                K = K + 1
                dArr(K, 1) = sArr(i, 1)
                dArr(K, K + 1) = "N"
            End If
        End If
    Next j
Next i
Sheets("Chinh").Range("A2").Resize(K, 32) = dArr
End Sub

Mà vẫn không được

Không được là không được cái gì=?

Gió Đông · 28/11/17

Võ đoán đại, sử dụng tạm cái này

PHP:

Public Sub Loc_nghi()
    Dim i As Long, j As Long, k As Long
    Dim sArr(), dArr(), OK As Boolean
   
    sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
    ReDim dArr(1 To UBound(sArr), 32)
   
    k = 1 'Row tieu de ngay
    For j = 2 To 125 Step 4
        dArr(k, 2 + (j - 2) \ 4) = sArr(1, j)
    Next j
   
    For i = 3 To UBound(sArr, 1)
        OK =True
        For j = 2 To 125 Step 4
            If Weekday(sArr(1, j)) <> 1 Then
                If IsEmpty(sArr(i, j)) Then
                    If  OK Then
                        OK = False
                        k = k + 1
                        dArr(k, 1) = sArr(i, 1)
                    End If
                    dArr(k, 2 + (j - 2) \ 4) = "N"
                End If
            End If
        Next j
    Next i
   
    Sheets("Chinh").Range("A2").Resize(k, 32) = dArr
    Sheets("Chinh").Activate
End Sub

tueyennhi · 29/11/17

Gió Đông đã viết:

Võ đoán đại, sử dụng tạm cái này

PHP:

Public Sub Loc_nghi()
    Dim i As Long, j As Long, k As Long
    Dim sArr(), dArr(), OK As Boolean
 
    sArr = Range("J6", Range("J65000").End(xlUp)).Resize(, 125).Value
    ReDim dArr(1 To UBound(sArr), 32)
 
    k = 1 'Row tieu de ngay
    For j = 2 To 125 Step 4
        dArr(k, 2 + (j - 2) \ 4) = sArr(1, j)
    Next j
 
    For i = 3 To UBound(sArr, 1)
        OK =True
        For j = 2 To 125 Step 4
            If Weekday(sArr(1, j)) <> 1 Then
                If IsEmpty(sArr(i, j)) Then
                    If  OK Then
                        OK = False
                        k = k + 1
                        dArr(k, 1) = sArr(i, 1)
                    End If
                    dArr(k, 2 + (j - 2) \ 4) = "N"
                End If
            End If
        Next j
    Next i
 
    Sheets("Chinh").Range("A2").Resize(k, 32) = dArr
    Sheets("Chinh").Activate
End Sub

Giờ mới có thời gian trả lời bạn. Cảm ơn bạn nhé, code đáp ứng đúng mong muốn của mình

.
Cái OK As Boolean hay nhưng mà vẫn luống cuống khi sử dụng nó. Các tháng sau nhờ có bạn mà công việc lại thêm suôn sẻ rồi

dephetnoi · 22/12/17

Có ai quan tâm bài này nữa không ạ? em đang loay hoay để chuyển cái code sang mảng mà làm mãi không được, code không báo lỗi nhưng lại không giống như cái mà em làm bằng code thường ạ? Bác nào chỉ giúp em với em cũng mới bập bẹ làm quen với VBa thôi ạ

befaint · 22/12/17

dephetnoi đã viết:
Có ai quan tâm bài này nữa không

Không!

------
Mình đọc lý thuyết rồi tự điều chỉnh xem, chứ xem file trên chịu luôn...

dephetnoi · 22/12/17

hiii, muốn code nhanh hơn thôi vì dữ liệu nhiều nó chạy nặng quá bạn ạ. Có cao thủ nào giúp em với em sửa cái code này mà chạy vẫn không đúng code thường :
Sub diennhancong1()
Dim arr()
Dim sarray As Variant
Dim i As Long
Dim j As Long
Range("j8:ae" & Range("kttd1").Row).ClearContents
sarray = Range("a7:z" & Range("kttd1").Row).Value
ReDim arr(1 To UBound(sarray), 1 To UBound(sarray, 2))
For i = 1 To UBound(sarray, 1)
For j = 1 To UBound(sarray, 2)
If arr(7, j) - arr(i, 5) < 6 And arr(7, j) - arr(i, 5) >= 0 And arr(i, 1) <> "HM" Then
arr(i, j ) = "[" & arr(i, 8) & " NC]"
With arr(i, j + arr(i, 4)).Font
.Name = "Times New Roman"
.Size = 10
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End If
Next
Next
Range("j8").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

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

Thành viên gắn bó

|||||||||||||

Cute Black Cat

|||||||||||||

Thành viên tích cực

Cute Black Cat

Thành viên thường trực

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Thành viên tích cực

Huyền thoại GPE

Thành viên gắn bó

Thành viên tích cực

File đính kèm

Thành viên tích cực

Thành viên tích cực

BĂNG TRÔI

BĂNG TRÔI

Thành viên tích cực

Thành viên chính thức

File đính kèm

|||||||||||||

Thành viên chính thức