Sự kiện Worksheet_Change chạy bị chậm (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)
H

hadoan-pap

Thành viên tiêu biểu
Tham gia
8/7/15
Bài viết
461
Được thích
20
Dear all,

Rất mong các bạn xem và kiểm tra giúp mình đoạn code sau mình đang để ở sự kiện Worksheet_Change . Mỗi lần click lên cell nhập xong data thì nó quay mất mấy giây và cảm giác bị chậm rất khó chịu. Rất mong đc các bạn hỗ trợ xem giúp mình đoạn code bị sai hoặc tối ưu như nào để nó nhanh hơn đc k.

Mình xin cảm ơn!

With Application
.Interactive = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Dim i As Integer
Dim j As Integer

If Sheet2.Cells(18, 3) <> 0 Then
If Sheet2.Cells(18, 3) < Sheet2.Cells(6, 9) Then
MsgBox "The Plan data could not smaller than AP date.", vbInformation, "Warning......!"
Sheet2.Cells(18, 3).Interior.ColorIndex = 45
Else
Sheet2.Cells(18, 3).Interior.ColorIndex = 2
End If
End If


If Sheet2.Cells(10, 2) = "General Expenditure" And Sheet2.Cells(10, 4) = "Purchase" Then
If Sheet2.Cells(10, 6) = "Tangible Goods" Or Sheet2.Cells(10, 6) = "Intangible Goods" Then
If Sheet2.Cells(25, 8) <> 0 And Sheet2.Cells(25, 8) > 30000000 Then
MsgBox "Check Whether FA Or Not.", vbInformation, "Warning......!"
Sheet2.Cells(25, 8).Interior.ColorIndex = 45
Else
Sheet2.Cells(18, 3).Interior.ColorIndex = 2
End If
End If
End If

If Sheet2.Cells(32, 4) <> 0 And Sheet2.Cells(32, 4) > 2300000 Then
MsgBox "Over Limited Amount.", vbInformation, "Warning...Entertainment Fee Only.!"
Sheet2.Cells(32, 4).Interior.ColorIndex = 45
Else
Sheet2.Cells(32, 4).Interior.ColorIndex = 2
End If

' check chu ky

Call RemoveStraightArrowConnectors

If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then

If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu

If Sheet2.Cells(25, 8) < 250000000 Then

'MsgBox "Over Li.", vbInformation, "test.!"

'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo

'Sheet7.Shapes("Straight Connector 1").Copy
'Sheet2.Paste Destination:=Range("G44")
Sheet2.Cells(44, 7).Interior.ColorIndex = 48
Sheet2.Cells(44, 7) = "Not Sign"
Else
Sheet2.Cells(44, 7).Interior.ColorIndex = 2
Sheet2.Cells(44, 7) = " "

End If
End If
End If


If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then

If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu

If Sheet2.Cells(25, 8) < 10000000 Then

'MsgBox "Over Li.", vbInformation, "test.!"

'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo

'Sheet7.Shapes("Straight Connector 2").Copy
'Sheet2.Paste Destination:=Range("H44")
'Sheet7.Shapes("Straight Connector 3").Copy
'Sheet2.Paste Destination:=Range("I44")

Sheet2.Cells(44, 8).Interior.ColorIndex = 48
Sheet2.Cells(44, 8) = "Not Sign"
Sheet2.Cells(44, 9).Interior.ColorIndex = 48
Sheet2.Cells(44, 9) = "Not Sign"
Else
Sheet2.Cells(44, 8).Interior.ColorIndex = 2
Sheet2.Cells(44, 8) = " "
Sheet2.Cells(44, 9).Interior.ColorIndex = 2
Sheet2.Cells(44, 9) = " "

End If
End If
End If

For i = 66 To 100

If Sheet2.Cells(16, 2) = Sheet5.Cells(i, 2) Then

Sheet2.Cells(16, 3) = Sheet5.Cells(i, 3)

End If

If Sheet2.Cells(16, 7) = Sheet5.Cells(i, 2) Then

Sheet2.Cells(16, 8) = Sheet5.Cells(i, 3)

End If

Next i

With Application
.Interactive = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Lướt sơ qua đoạn code thì mình có nhận xét rằng hầu hết dữ liệu được xử lý trên sheet thì chậm là điều đương nhiên. Nhìn cái vòng lặp For Next của bạn cũng đủ thấy code này sẽ cực kỳ chậm. Muốn nhanh phải chuyển sang mảng thôi.
 
Upvote 0
hadoan-pap đã viết:
MsgBox "Check Whether FA Or Not.", vbInformation, "Warning......!"
MsgBox "Over Limited Amount.", vbInformation, "Warning...Entertainment Fee Only.!"
Nhấp chuột vào đây để mở rộng...
sao chạy code mà cứ cho hiện Msgbox lên thế bạn.
như anh Hải nói, muốn nhanh thì cho vô mảng để xử lý sẽ nhanh hơn
xử lý xong điền 1 phát xuống sheet là xong, với lại bạn vừa xử lý dữ liệu mà còn copy dán, tô màu... như thế sẽ ảnh hưởng đến tốc độ của code ấy.
code bạn gửi hơi khó nhìn, xin gửi lại code đã index cho dễ nhìn chút
nếu bạn bỏ phần tô màu đi thì bạn gán 1 mảng ví dụ mảng tên "Arr" để lấy toàn bộ dữ liệu tại sheet2
xong thay thế "Sheet2.cells" thành "Arr", sau khi xử lý xong thì bạn chép ngược lại vào sheet, như thế tốc độ sẽ nhanh hơn ban đầu
Mã: 
Sub GPE()
    With Application
        .Interactive = False
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    Dim i As Integer
    Dim j As Integer
  
    If Sheet2.Cells(18, 3) <> 0 Then
        If Sheet2.Cells(18, 3) < Sheet2.Cells(6, 9) Then
            MsgBox "The Plan data could not smaller than AP date.", vbInformation, "Warning......!"
            Sheet2.Cells(18, 3).Interior.ColorIndex = 45
        Else
            Sheet2.Cells(18, 3).Interior.ColorIndex = 2
        End If
    End If
  
    If Sheet2.Cells(10, 2) = "General Expenditure" And Sheet2.Cells(10, 4) = "Purchase" Then
        If Sheet2.Cells(10, 6) = "Tangible Goods" Or Sheet2.Cells(10, 6) = "Intangible Goods" Then
            If Sheet2.Cells(25, 8) <> 0 And Sheet2.Cells(25, 8) > 30000000 Then
                MsgBox "Check Whether FA Or Not.", vbInformation, "Warning......!"
                Sheet2.Cells(25, 8).Interior.ColorIndex = 45
            Else
                Sheet2.Cells(18, 3).Interior.ColorIndex = 2
            End If
        End If
    End If
    If Sheet2.Cells(32, 4) <> 0 And Sheet2.Cells(32, 4) > 2300000 Then
        MsgBox "Over Limited Amount.", vbInformation, "Warning...Entertainment Fee Only.!"
        Sheet2.Cells(32, 4).Interior.ColorIndex = 45
    Else
        Sheet2.Cells(32, 4).Interior.ColorIndex = 2
    End If
    ' check chu ky
    Call RemoveStraightArrowConnectors
    If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then
        If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu
            If Sheet2.Cells(25, 8) < 250000000 Then
                'MsgBox "Over Li.", vbInformation, "test.!"
                'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo
                'Sheet7.Shapes("Straight Connector 1").Copy
                'Sheet2.Paste Destination:=Range("G44")
                Sheet2.Cells(44, 7).Interior.ColorIndex = 48
                Sheet2.Cells(44, 7) = "Not Sign"
            Else
                Sheet2.Cells(44, 7).Interior.ColorIndex = 2
                Sheet2.Cells(44, 7) = " "
            End If
        End If
    End If
    If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then
        If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu
            If Sheet2.Cells(25, 8) < 10000000 Then
                'MsgBox "Over Li.", vbInformation, "test.!"
                'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo
                'Sheet7.Shapes("Straight Connector 2").Copy
                'Sheet2.Paste Destination:=Range("H44")
                'Sheet7.Shapes("Straight Connector 3").Copy
                'Sheet2.Paste Destination:=Range("I44")
                Sheet2.Cells(44, 8).Interior.ColorIndex = 48
                Sheet2.Cells(44, 8) = "Not Sign"
                Sheet2.Cells(44, 9).Interior.ColorIndex = 48
                Sheet2.Cells(44, 9) = "Not Sign"
            Else
                Sheet2.Cells(44, 8).Interior.ColorIndex = 2
                Sheet2.Cells(44, 8) = " "
                Sheet2.Cells(44, 9).Interior.ColorIndex = 2
                Sheet2.Cells(44, 9) = " "
            End If
        End If
    End If
    For i = 66 To 100
        If Sheet2.Cells(16, 2) = Sheet5.Cells(i, 2) Then
            Sheet2.Cells(16, 3) = Sheet5.Cells(i, 3)
        End If
        If Sheet2.Cells(16, 7) = Sheet5.Cells(i, 2) Then
            Sheet2.Cells(16, 8) = Sheet5.Cells(i, 3)
        End If
    Next i
    With Application
        .Interactive = True
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
 
Upvote 0
hadoan-pap đã viết:
Dear all,

Rất mong các bạn xem và kiểm tra giúp mình đoạn code sau mình đang để ở sự kiện Worksheet_Change . Mỗi lần click lên cell nhập xong data thì nó quay mất mấy giây và cảm giác bị chậm rất khó chịu. Rất mong đc các bạn hỗ trợ xem giúp mình đoạn code bị sai hoặc tối ưu như nào để nó nhanh hơn đc k.

Mình xin cảm ơn!

With Application
.Interactive = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Dim i As Integer
Dim j As Integer

If Sheet2.Cells(18, 3) <> 0 Then
If Sheet2.Cells(18, 3) < Sheet2.Cells(6, 9) Then
MsgBox "The Plan data could not smaller than AP date.", vbInformation, "Warning......!"
Sheet2.Cells(18, 3).Interior.ColorIndex = 45
Else
Sheet2.Cells(18, 3).Interior.ColorIndex = 2
End If
End If


If Sheet2.Cells(10, 2) = "General Expenditure" And Sheet2.Cells(10, 4) = "Purchase" Then
If Sheet2.Cells(10, 6) = "Tangible Goods" Or Sheet2.Cells(10, 6) = "Intangible Goods" Then
If Sheet2.Cells(25, 8) <> 0 And Sheet2.Cells(25, 8) > 30000000 Then
MsgBox "Check Whether FA Or Not.", vbInformation, "Warning......!"
Sheet2.Cells(25, 8).Interior.ColorIndex = 45
Else
Sheet2.Cells(18, 3).Interior.ColorIndex = 2
End If
End If
End If

If Sheet2.Cells(32, 4) <> 0 And Sheet2.Cells(32, 4) > 2300000 Then
MsgBox "Over Limited Amount.", vbInformation, "Warning...Entertainment Fee Only.!"
Sheet2.Cells(32, 4).Interior.ColorIndex = 45
Else
Sheet2.Cells(32, 4).Interior.ColorIndex = 2
End If

' check chu ky

Call RemoveStraightArrowConnectors

If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then

If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu

If Sheet2.Cells(25, 8) < 250000000 Then

'MsgBox "Over Li.", vbInformation, "test.!"

'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo

'Sheet7.Shapes("Straight Connector 1").Copy
'Sheet2.Paste Destination:=Range("G44")
Sheet2.Cells(44, 7).Interior.ColorIndex = 48
Sheet2.Cells(44, 7) = "Not Sign"
Else
Sheet2.Cells(44, 7).Interior.ColorIndex = 2
Sheet2.Cells(44, 7) = " "

End If
End If
End If


If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then

If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu

If Sheet2.Cells(25, 8) < 10000000 Then

'MsgBox "Over Li.", vbInformation, "test.!"

'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo

'Sheet7.Shapes("Straight Connector 2").Copy
'Sheet2.Paste Destination:=Range("H44")
'Sheet7.Shapes("Straight Connector 3").Copy
'Sheet2.Paste Destination:=Range("I44")

Sheet2.Cells(44, 8).Interior.ColorIndex = 48
Sheet2.Cells(44, 8) = "Not Sign"
Sheet2.Cells(44, 9).Interior.ColorIndex = 48
Sheet2.Cells(44, 9) = "Not Sign"
Else
Sheet2.Cells(44, 8).Interior.ColorIndex = 2
Sheet2.Cells(44, 8) = " "
Sheet2.Cells(44, 9).Interior.ColorIndex = 2
Sheet2.Cells(44, 9) = " "

End If
End If
End If

For i = 66 To 100

If Sheet2.Cells(16, 2) = Sheet5.Cells(i, 2) Then

Sheet2.Cells(16, 3) = Sheet5.Cells(i, 3)

End If

If Sheet2.Cells(16, 7) = Sheet5.Cells(i, 2) Then

Sheet2.Cells(16, 8) = Sheet5.Cells(i, 3)

End If

Next i

With Application
.Interactive = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
Nhấp chuột vào đây để mở rộng...
chỉnh vòng lặp để tăng tốc độ code
Mã: 
Dim Arr(), dk1, dk2, Test1 As Boolean, Test2 As Boolean ...
...
Arr=Sheet5.Range("B66:C100").Value
...
dk1 = Sheet2.Cells(16, 2)
dk2 = Sheet2.Cells(16, 7)
For i = UBound(Arr) To 1
  If Test1 = False Then
    If dk1 = Arr(i, 1) Then
      Sheet2.Cells(16, 3) = Arr(i, 2)
      Test1 = True
    End If
  End If
  If Test2 = False Then
    If dk2 = Arr(i, 1) Then
      Sheet2.Cells(16, 3) = Arr(i, 2)
      Test2 = True
    End If
  End If
  If Test1 = True And Test2 = True Then Exit For
Next i
.....
 
Upvote 0
Cảm ơn mọi ng nhiều nhé. Mình k có kinh nghiệm VB nên con non nớt :).
 
Upvote 0
Mutants Men đã viết:
sao chạy code mà cứ cho hiện Msgbox lên thế bạn.
như anh Hải nói, muốn nhanh thì cho vô mảng để xử lý sẽ nhanh hơn
xử lý xong điền 1 phát xuống sheet là xong, với lại bạn vừa xử lý dữ liệu mà còn copy dán, tô màu... như thế sẽ ảnh hưởng đến tốc độ của code ấy.
code bạn gửi hơi khó nhìn, xin gửi lại code đã index cho dễ nhìn chút
nếu bạn bỏ phần tô màu đi thì bạn gán 1 mảng ví dụ mảng tên "Arr" để lấy toàn bộ dữ liệu tại sheet2
xong thay thế "Sheet2.cells" thành "Arr", sau khi xử lý xong thì bạn chép ngược lại vào sheet, như thế tốc độ sẽ nhanh hơn ban đầu
Mã: 
Sub GPE()
    With Application
        .Interactive = False
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    Dim i As Integer
    Dim j As Integer
 
    If Sheet2.Cells(18, 3) <> 0 Then
        If Sheet2.Cells(18, 3) < Sheet2.Cells(6, 9) Then
            MsgBox "The Plan data could not smaller than AP date.", vbInformation, "Warning......!"
            Sheet2.Cells(18, 3).Interior.ColorIndex = 45
        Else
            Sheet2.Cells(18, 3).Interior.ColorIndex = 2
        End If
    End If
 
    If Sheet2.Cells(10, 2) = "General Expenditure" And Sheet2.Cells(10, 4) = "Purchase" Then
        If Sheet2.Cells(10, 6) = "Tangible Goods" Or Sheet2.Cells(10, 6) = "Intangible Goods" Then
            If Sheet2.Cells(25, 8) <> 0 And Sheet2.Cells(25, 8) > 30000000 Then
                MsgBox "Check Whether FA Or Not.", vbInformation, "Warning......!"
                Sheet2.Cells(25, 8).Interior.ColorIndex = 45
            Else
                Sheet2.Cells(18, 3).Interior.ColorIndex = 2
            End If
        End If
    End If
    If Sheet2.Cells(32, 4) <> 0 And Sheet2.Cells(32, 4) > 2300000 Then
        MsgBox "Over Limited Amount.", vbInformation, "Warning...Entertainment Fee Only.!"
        Sheet2.Cells(32, 4).Interior.ColorIndex = 45
    Else
        Sheet2.Cells(32, 4).Interior.ColorIndex = 2
    End If
    ' check chu ky
    Call RemoveStraightArrowConnectors
    If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then
        If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu
            If Sheet2.Cells(25, 8) < 250000000 Then
                'MsgBox "Over Li.", vbInformation, "test.!"
                'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo
                'Sheet7.Shapes("Straight Connector 1").Copy
                'Sheet2.Paste Destination:=Range("G44")
                Sheet2.Cells(44, 7).Interior.ColorIndex = 48
                Sheet2.Cells(44, 7) = "Not Sign"
            Else
                Sheet2.Cells(44, 7).Interior.ColorIndex = 2
                Sheet2.Cells(44, 7) = " "
            End If
        End If
    End If
    If Sheet2.Cells(10, 2) = "General Expenditure" Or Sheet2.Cells(10, 2) = "Tools & equipments" Then
        If IsEmpty(Sheets("Approval sheet Form").Range("H25")) = False Then ' Kiem tra dieu kien H25 co du lieu
            If Sheet2.Cells(25, 8) < 10000000 Then
                'MsgBox "Over Li.", vbInformation, "test.!"
                'Sheets("Sheet1").Range("A1").Copy Destination:=Sheets("2.Approval sheet (PV) (4)").Range("G45") ' Copy dau gach cheo
                'Sheet7.Shapes("Straight Connector 2").Copy
                'Sheet2.Paste Destination:=Range("H44")
                'Sheet7.Shapes("Straight Connector 3").Copy
                'Sheet2.Paste Destination:=Range("I44")
                Sheet2.Cells(44, 8).Interior.ColorIndex = 48
                Sheet2.Cells(44, 8) = "Not Sign"
                Sheet2.Cells(44, 9).Interior.ColorIndex = 48
                Sheet2.Cells(44, 9) = "Not Sign"
            Else
                Sheet2.Cells(44, 8).Interior.ColorIndex = 2
                Sheet2.Cells(44, 8) = " "
                Sheet2.Cells(44, 9).Interior.ColorIndex = 2
                Sheet2.Cells(44, 9) = " "
            End If
        End If
    End If
    For i = 66 To 100
        If Sheet2.Cells(16, 2) = Sheet5.Cells(i, 2) Then
            Sheet2.Cells(16, 3) = Sheet5.Cells(i, 3)
        End If
        If Sheet2.Cells(16, 7) = Sheet5.Cells(i, 2) Then
            Sheet2.Cells(16, 8) = Sheet5.Cells(i, 3)
        End If
    Next i
    With Application
        .Interactive = True
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
Nhấp chuột vào đây để mở rộng...

Bạn ơi bạn có thể mẫu ví dụ mình xem đc k? Mình còn yếu về mảng lắm nên k rõ là sẽ làm ntn. Cảm ơn bạn!
 
Upvote 0
hadoan-pap đã viết:
Bạn ơi bạn có thể mẫu ví dụ mình xem đc k? Mình còn yếu về mảng lắm nên k rõ là sẽ làm ntn. Cảm ơn bạn!
Nhấp chuột vào đây để mở rộng...
bạn tham khảo bài này (hình như các cao thủ võ lâm đều trải qua quá trình luyện tập bên đây- nếu nhớ không nhầm)
ví dụ thế này
ban đầu bạn khai báo mảng
Mã: 
Dim Arr as Variant
sau đó bạn lấy dữ liệu tại 1 vùng bất kỳ trên sheet (ví dụ ở đây ta lấy dữ liệu từ sheet)
ví dụ muốn lấy dữ liệu tại Sheet1!A1:H1000 thì bạn có thể viết
Mã: 
Arr = Sheets("Sheet1").range("A1:H1000")
hoặc
Mã: 
Arr = Sheets("Sheet1").["A1:H1000"]
lúc này Arr(1,1) sẽ tương ứng với ô A1 tại Sheet1
Arr(x,y)- x: dòng, y: cột
còn nếu muốn lấy dữ liệu tại Sheet1!B3:H1000 thì bạn có thể viết
Mã: 
Arr = Sheets("Sheet1").range("B3:H1000")
lúc này Arr(1,1) sẽ tương ứng với ô B3 tại Sheet1
nếu bạn lấy dữ liệu theo 2 cách trên thì vị trí bắt đầu của mảng =1
còn nếu không biết vị trí bắt đầu kết thúc là bao nhiêu thì bạn có thể dùng hàm ubound với lbound
chép code này vào module rồi chạy thử để biết cách sử dụng và giá trị trả về của ubound với lbound bạn nhé
Mã: 
Sub GPE()
    Dim Arr As Variant
    ReDim Arr(1000)    'neu khai bao nhu vay thi mac dinh dong dau tien cua mang = 0
    MsgBox "Khai bao mang Arr(" & LBound(Arr) & " To " & UBound(Arr) & ") " & ChrW(10) & _
           " + Can tren LBound(Arr): " & LBound(Arr) & ChrW(10) & _
           " + Can tren LBound(Arr,1): " & LBound(Arr, 1) & ChrW(10) & _
           " + Can duoi uBound(Arr): " & UBound(Arr) & ChrW(10) & _
           " + Can duoi uBound(Arr,1): " & UBound(Arr, 1)
    ReDim Arr(3 To 5, 10 To 11)
    MsgBox "Khai bao mang Arr(" & _
           LBound(Arr, 1) & " To " & UBound(Arr, 1) & ", " & _
           LBound(Arr, 2) & " To " & UBound(Arr, 2) & ") " & ChrW(10) & _
           " * Mang co " & UBound(Arr, 1) - LBound(Arr, 1) + 1 & " dong, " & UBound(Arr, 2) - LBound(Arr, 2) + 1 & " cot" & ChrW(10) & _
           "  + Can tren LBound(Arr,1): " & LBound(Arr, 1) & ChrW(10) & _
           "  + Can duoi uBound(Arr,1): " & UBound(Arr, 1) & ChrW(10) & _
           "  + Can trai LBound(Arr,2): " & LBound(Arr, 2) & ChrW(10) & _
           "  + Can phai uBound(Arr,2): " & UBound(Arr, 2)
End Sub
chạy code sau để xem cách lấy dữ liệu, xử lý dữ liệu, điền dữ liệu nhé
Mã: 
Sub GPE1()
    Dim Arr As Variant
    'lay du lieu vao mang
    Arr = Sheets("Sheet1").Range("B3:C10")
    'xu ly du lieu
    Arr(1, 1) = "Day la gia tri tai cua Arr(1,1)"
    Arr(2, 1) = "Day la gia tri tai cua Arr(2,1)"
    Arr(4, 2) = "Day la gia tri tai cua Arr(4,2)"
    Arr(4, 1) = "Day la gia tri tai cua Arr(4,1)"
    Arr(8, 2) = "Day la gia tri tai cua Arr(8,2)"
    'dien du lieu vao sheet
    Range("B3").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
End Sub
lưu ý
khi bạn dùng Redim thì toàn bộ dữ liệu trong mảng mà bạn redim sẽ mất hết
để không mất dữ liệu thì bạn dùng lệnh sau
ReDim Preserve Arr(1 To 2, 1 To n)
chỗ 1 To 2 là số dòng của mảng, không thay đổi được
chỉ có thể thay đổi giá trị n trong 1 To n (tức thay đổi số cột)
--------------------------------
vài dòng chia sẻ với bạn
chúc bạn tập tành với mảng thành công nhé
do mình cũng là người mới tìm hiểu VBA nên cũng không biết nhiều. nếu cao thủ nào lướt qua thấy em hướng dẫn có gì sai hay thiếu sót mong có thể hướng dẫn thêm cho em cùng với chủ topic để có thể hiểu thêm về mảng.
 
Upvote 0
Mutants Men đã viết:
bạn tham khảo bài này (hình như các cao thủ võ lâm đều trải qua quá trình luyện tập bên đây- nếu nhớ không nhầm)
ví dụ thế này
ban đầu bạn khai báo mảng
Mã: 
Dim Arr as Variant
sau đó bạn lấy dữ liệu tại 1 vùng bất kỳ trên sheet (ví dụ ở đây ta lấy dữ liệu từ sheet)
ví dụ muốn lấy dữ liệu tại Sheet1!A1:H1000 thì bạn có thể viết
Mã: 
Arr = Sheets("Sheet1").range("A1:H1000")
hoặc
Mã: 
Arr = Sheets("Sheet1").["A1:H1000"]
lúc này Arr(1,1) sẽ tương ứng với ô A1 tại Sheet1
Arr(x,y)- x: dòng, y: cột
còn nếu muốn lấy dữ liệu tại Sheet1!B3:H1000 thì bạn có thể viết
Mã: 
Arr = Sheets("Sheet1").range("B3:H1000")
lúc này Arr(1,1) sẽ tương ứng với ô B3 tại Sheet1
nếu bạn lấy dữ liệu theo 2 cách trên thì vị trí bắt đầu của mảng =1
còn nếu không biết vị trí bắt đầu kết thúc là bao nhiêu thì bạn có thể dùng hàm ubound với lbound
chép code này vào module rồi chạy thử để biết cách sử dụng và giá trị trả về của ubound với lbound bạn nhé
Mã: 
Sub GPE()
    Dim Arr As Variant
    ReDim Arr(1000)    'neu khai bao nhu vay thi mac dinh dong dau tien cua mang = 0
    MsgBox "Khai bao mang Arr(" & LBound(Arr) & " To " & UBound(Arr) & ") " & ChrW(10) & _
           " + Can tren LBound(Arr): " & LBound(Arr) & ChrW(10) & _
           " + Can tren LBound(Arr,1): " & LBound(Arr, 1) & ChrW(10) & _
           " + Can duoi uBound(Arr): " & UBound(Arr) & ChrW(10) & _
           " + Can duoi uBound(Arr,1): " & UBound(Arr, 1)
    ReDim Arr(3 To 5, 10 To 11)
    MsgBox "Khai bao mang Arr(" & _
           LBound(Arr, 1) & " To " & UBound(Arr, 1) & ", " & _
           LBound(Arr, 2) & " To " & UBound(Arr, 2) & ") " & ChrW(10) & _
           " * Mang co " & UBound(Arr, 1) - LBound(Arr, 1) + 1 & " dong, " & UBound(Arr, 2) - LBound(Arr, 2) + 1 & " cot" & ChrW(10) & _
           "  + Can tren LBound(Arr,1): " & LBound(Arr, 1) & ChrW(10) & _
           "  + Can duoi uBound(Arr,1): " & UBound(Arr, 1) & ChrW(10) & _
           "  + Can trai LBound(Arr,2): " & LBound(Arr, 2) & ChrW(10) & _
           "  + Can phai uBound(Arr,2): " & UBound(Arr, 2)
End Sub
chạy code sau để xem cách lấy dữ liệu, xử lý dữ liệu, điền dữ liệu nhé
Mã: 
Sub GPE1()
    Dim Arr As Variant
    'lay du lieu vao mang
    Arr = Sheets("Sheet1").Range("B3:C10")
    'xu ly du lieu
    Arr(1, 1) = "Day la gia tri tai cua Arr(1,1)"
    Arr(2, 1) = "Day la gia tri tai cua Arr(2,1)"
    Arr(4, 2) = "Day la gia tri tai cua Arr(4,2)"
    Arr(4, 1) = "Day la gia tri tai cua Arr(4,1)"
    Arr(8, 2) = "Day la gia tri tai cua Arr(8,2)"
    'dien du lieu vao sheet
    Range("B3").Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
End Sub
lưu ý
khi bạn dùng Redim thì toàn bộ dữ liệu trong mảng mà bạn redim sẽ mất hết
để không mất dữ liệu thì bạn dùng lệnh sau
ReDim Preserve Arr(1 To 2, 1 To n)
chỗ 1 To 2 là số dòng của mảng, không thay đổi được
chỉ có thể thay đổi giá trị n trong 1 To n (tức thay đổi số cột)
--------------------------------
vài dòng chia sẻ với bạn
chúc bạn tập tành với mảng thành công nhé
do mình cũng là người mới tìm hiểu VBA nên cũng không biết nhiều. nếu cao thủ nào lướt qua thấy em hướng dẫn có gì sai hay thiếu sót mong có thể hướng dẫn thêm cho em cùng với chủ topic để có thể hiểu thêm về mảng.
Nhấp chuột vào đây để mở rộng...
Chân Thành cảm ơn bạn rất nhiều. Mình sẽ đọc và tìm hiểu kỹ hơn về mảng, mình thực sự rất yếu về nó do VBA chỉ là 1 job nhỏ mà mình đang support nên k có thời gian dành cho nó nhiều.

Cảm ơn bạn và mọi ng nhiều nhé!
 
Upvote 0
Mutants Men đã viết:
bạn tham khảo bài này (hình như các cao thủ võ lâm đều trải qua quá trình luyện tập bên đây- nếu nhớ không nhầm)
Nhấp chuột vào đây để mở rộng...
Mình chỉ trải qua quá trình luyện tập khác. Hèn gì mình chẳng phải võ lâm mà lại càng xa cao thủ.

(mà làm việc với dữ liệu chứ thượng đài hay bán thuốc Sơn Đông hay sao mà có thủ có võ trong này nữa)
 
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

S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU (4 người xem)
Trả lời
9
Đọc
98
Duy Tùng 9x
Duy Tùng 9x
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng, (3 người xem)
Trả lời
8
Đọc
37
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng (1 người xem)
Trả lời
11
Đọc
41
Duy Tùng 9x
Duy Tùng 9x
B
XIN HƯỚNG DẪN CÁCH ĐỂ HÀM XLOOKUP TỰ NHẢY THEO SỐ LƯỢNG DÒNG CỦA ĐIỀU KIỆN KHÔNG SỬ DỤNG VBA (1 người xem)
Trả lời
2
Đọc
23
Duy Tùng 9x
Duy Tùng 9x
C
Filter có điều kiện đang ở dạng Cột
Trả lời
2
Đọc
34
thuytrangbp28
T
L
Có ai biết fix lỗi này không ạ (3 người xem)
    • Buồn
Trả lời
2
Đọc
29
lekimhuy0812
L
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác (1 người xem)
Trả lời
5
Đọc
165
Gà Công Nghệ
Gà Công Nghệ
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại
Trả lời
0
Đọc
29
Kecodonlalala
K
N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình (1 người xem)
    • Cảm ơn
    • Thích
Trả lời
7
Đọc
141
newbiexo
N
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
3
Đọc
63
Nguyễn Duy Tuân
Nguyễn Duy Tuân
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application
    • Thích
Trả lời
2
Đọc
137
Nguyễn Duy Tuân
Nguyễn Duy Tuân
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
7
Đọc
328
PhanTuHuong
PhanTuHuong
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
    • Yêu thích
Trả lời
1
Đọc
64
PhanTuHuong
PhanTuHuong
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
8
Đọc
188
thuytrangbp28
T
K
Làm sao để ô excel hiển thị tên nhưng khi nhấp vào thì đó là công thức
Trả lời
1
Đọc
47
pycckuu410
P
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
41
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
326
Đọc
25K
pycckuu410
P
V
  • Question Question
Đếm xếp loại của đơn hàng
Trả lời
8
Đọc
223
vanlinh_2904
V
J
Công thức tính lương khi mỗi tháng tăng lương cơ bản
Trả lời
2
Đọc
77
jangne88
J
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom