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,599
Đượ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
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. ;)
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
hàm CopyMemory hay đó , có thể dùng nó như kiểu con trỏ đến bộ nhớ trong c vậy !^^
 
Upvote 0
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.
 

File đính kèm

  • Loi la.xlsb
    180.8 KB · Đọc: 7
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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)
 
Upvote 0
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.
 

File đính kèm

  • Loi la 2.xlsb
    849.7 KB · Đọc: 19
Upvote 0
tueyennhi đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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ế
 
Upvote 0
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ế
Nhấp chuột vào đây để mở rộng...
À 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
 
Upvote 0
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...
Nhấp chuột vào đây để mở rộng...
Ô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 đỡ!
 
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

Không được là không được cái gì=?
 
Upvote 0
Võ đoán đại, sử dụng tạm cái nà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
 
Upvote 0
Gió Đông đã viết:
Võ đoán đại, sử dụng tạm cái nà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
Nhấp chuột vào đây để mở rộng...
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 :)
 
Lần chỉnh sửa cuối:
Upvote 0
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 ạ
 

File đính kèm

  • vi du mang.xlsm
    232.5 KB · Đọc: 17
Upvote 0
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
 
Upvote 0
Em sửa lại cái này nhưng nó chạy bỏ qua 2 dòng không hiểu vì sao ạ?
Sub diennhancong1()
Dim arr()
Dim sarray As Variant
Dim i As Long
Dim j As Long
Range("i8:ae" & Range("kttd1").Row).ClearContents
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
sarray = Range("a8:z" & Range("kttd1").Row - 1).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)
'arr(i, j).ClearContents
If Cells(7, j).Value - Cells(i + 7, 5).Value < 6 And Cells(7, j).Value - Cells(i + 7, 5).Value >= 0 And Cells(i + 7, 1).Value <> "HM" Then
arr(i, j - 8) = "[" & Cells(i + 7, 8) & " NC]"
With arr(i, j).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
Range("j8:z" & Range("kttd1").Row - 1).Value = arr()
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0
dephetnoi đã viết:
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 ạ
Nhấp chuột vào đây để mở rộng...
Lập riêng chủ đề đi cho rõ ràng, và cần viết chi tiết - để vào cái chủ đề hũ lút này thì sao mà quan tâm
 
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

T
Nhờ anh chụ giúp hiện tôi đang kết nối SQL Server lấy dữ liệu nhưng bị lỗi nên nhờ anh chị giúp
Trả lời
13
Đọc
135
Trần Văn Bình
T
67k8899
Xin giúp đỡ - Lỗi khi lọc bằng hàm Subtotal + Counta
Trả lời
2
Đọc
44
Hoàng Tuấn 868
H
nghiky
Cách tìm kiếm và lọc số người
Trả lời
4
Đọc
86
Hoàng Tuấn 868
H
Nguyễn Duy Tuân
Add-in Grid HighLighter – Tự động kẻ sáng đường viền dòng và cột tại ô nhập liệu
    • Thích
2
Trả lời
22
Đọc
17K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
giaiphap
Chia sẻ Add-ins GridHighlighter Open Source
    • Thích
2 3
Trả lời
41
Đọc
8K
xuandedhxd
X
Xem thêm…

Facebook

Giaiphapexcel.com

Group

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

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