Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631

[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Nhờ a chị xem vì sao code bị lỗi "Compile error: User - defined type not defined.
Public Sub ShowDonGia()
FormDonGia.Show
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Chào cả nhà GPEX,

Mình chưa thạo code VBA nên khi chạy bị lỗi. Nó báo lỗi ở dòng mình bôi tím:
'Delete Empty Sheets
Application.DisplayAlerts = False
Sheets(J.Value).Delete
Application.DisplayAlerts = True

Các ACE xem giúp mình. Cảm ơn cả nhà nhiều ạ.
 

File đính kèm

  • _Checkfilesempty_Run.xlsm
    26.2 KB · Đọc: 10
Upvote 0
Xin chuyển nội dung sang mục khác ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
Cả nhà ơi cho mình hỏi vấn đề về mảng này với. Mình có 1 hàm loại bỏ các giá trị trùng trong mảng sau khi mình dùng hàm function xong thì mình quay trở lại gán nó vào 1 biến Vdata1 (Variant) thì nó báo lỗi của mình Type mismatch (Run time Error 13) Do mình mới học nên chưa rõ lắm mong mọi người chỉ giáo thêm ạ CÁM ƠN
Mã:
Function RemoveDuplicatesVariant(DataArr As Variant) As Variant
    Dim newArr()
    Dim dupArrIndex As Integer, i As Integer, j As Integer
    Dim dupBool As Boolean
    dupArrIndex = -1
    For i = LBound(DataArr) To UBound(DataArr)
        dupBool = True
        For j = LBound(DataArr) To i
            If DataArr(i, 1) = DataArr(j, 1) And (DataArr(i, 4) = DataArr(j, 4)) And Not i = j Then
            dupBool = False
            End If
        Next j
        If dupBool = True Then
            dupArrIndex = dupArrIndex + 1
            ReDim Preserve newArr(dupArrIndex)
            newArr(dupArrIndex) = Array(DataArr(i, 1), DataArr(i, 4))
        End If
    Next i
    RemoveDuplicatesVariant = newArr
End Function
Mã:
Sub RemoveDupicates()
    Dim iLastRowRider As Integer, iLastRowDate As Integer
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim rDate As Range
    Dim vDate As Variant
    Dim vDate1 As Variant
    Dim Data As Worksheet, test As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Data = wb.Sheets("Data")
    Set test = wb.Sheets("Test")
    
    
    'Lay ngay
     test.Range("A4:A1048576").ClearContents
    iLastRowDate = Data.Range("B" & Rows.Count).End(xlUp).Row
    Set rDate = Data.Range("B2:E" & iLastRowDate)
    Set vDate = rDate

    
    Set vDate1 = RemoveDuplicatesVariant(vDate.Value2) 'Bị báo lỗi
  MsgBox (vDate1.Rows.Count)
End Sub
 
Upvote 0
Cả nhà ơi cho mình hỏi vấn đề về mảng này với. Mình có 1 hàm loại bỏ các giá trị trùng trong mảng sau khi mình dùng hàm function xong thì mình quay trở lại gán nó vào 1 biến Vdata1 (Variant) thì nó báo lỗi của mình Type mismatch (Run time Error 13) Do mình mới học nên chưa rõ lắm mong mọi người chỉ giáo thêm ạ CÁM ƠN
Mã:
Function RemoveDuplicatesVariant(DataArr As Variant) As Variant
    Dim newArr()
    Dim dupArrIndex As Integer, i As Integer, j As Integer
    Dim dupBool As Boolean
    dupArrIndex = -1
    For i = LBound(DataArr) To UBound(DataArr)
        dupBool = True
        For j = LBound(DataArr) To i
            If DataArr(i, 1) = DataArr(j, 1) And (DataArr(i, 4) = DataArr(j, 4)) And Not i = j Then
            dupBool = False
            End If
        Next j
        If dupBool = True Then
            dupArrIndex = dupArrIndex + 1
            ReDim Preserve newArr(dupArrIndex)
            newArr(dupArrIndex) = Array(DataArr(i, 1), DataArr(i, 4))
        End If
    Next i
    RemoveDuplicatesVariant = newArr
End Function
Mã:
Sub RemoveDupicates()
    Dim iLastRowRider As Integer, iLastRowDate As Integer
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim rDate As Range
    Dim vDate As Variant
    Dim vDate1 As Variant
    Dim Data As Worksheet, test As Worksheet
   
    Application.ScreenUpdating = False
   
    Set Data = wb.Sheets("Data")
    Set test = wb.Sheets("Test")
   
   
    'Lay ngay
     test.Range("A4:A1048576").ClearContents
    iLastRowDate = Data.Range("B" & Rows.Count).End(xlUp).Row
    Set rDate = Data.Range("B2:E" & iLastRowDate)
    Set vDate = rDate

   
    Set vDate1 = RemoveDuplicatesVariant(vDate.Value2) 'Bị báo lỗi
  MsgBox (vDate1.Rows.Count)
End Sub
Thường thì lỗi mismatch là lỗi không tương đồng giữa kiểu biến đã khai báo với kiểu giá trị biến vừa gán.
 
Upvote 0
Mình có 1 thắc mắc là mình muốn filter nhưng giá trị lớn hơn 3 trong mảng thì phải làm sao ạ mình có thể dùng hàm Filter được không còn hàm dưới thì chỉ trả cho mình tới 2 giá trị đó là 1,10 mình cám ơn
Mã:
Sub FilterArray()
 Dim a,b As Variant
a =Array(1,2,3,4,5,6,7,8,9,10)
b= Filter(a,1)
For each x In b
  MsgBox(x)
Next
 
Upvote 0
Mình có 1 thắc mắc là mình muốn filter nhưng giá trị lớn hơn 3 trong mảng thì phải làm sao ạ mình có thể dùng hàm Filter được không còn hàm dưới thì chỉ trả cho mình tới 2 giá trị đó là 1,10 mình cám ơn
Mã:
Sub FilterArray()
 Dim a,b As Variant
a =Array(1,2,3,4,5,6,7,8,9,10)
b= Filter(a,1)
For each x In b
  MsgBox(x)
Next
Bỏ filter đi, chỉ cần for next là đủ
for i = 1 to ubound(a)
if a(i) > 3 then msgbox(a(i))
Next
 
Upvote 0
Mình có 1 thắc mắc là mình muốn filter nhưng giá trị lớn hơn 3 trong mảng thì phải làm sao ạ mình có thể dùng hàm Filter được không còn hàm dưới thì chỉ trả cho mình tới 2 giá trị đó là 1,10 mình cám ơn
Mã:
Sub FilterArray()
 Dim a,b As Variant
a =Array(1,2,3,4,5,6,7,8,9,10)
b= Filter(a,1)
For each x In b
  MsgBox(x)
Next
Mã:
Sub FilterArray()
  Dim a As Variant
  a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  For Each i In a
    For Each x In Filter(a, i)
      MsgBox (x)
    Next
  Next
End Sub
 
Upvote 0
Cho mình hỏi xí về hàm Countifs trong VBA với minh có tiềm hiểu trên Internet về hàm Countifs như thế này
Mã:
[COUNTIFS(Data!E2:E1048576,Test!B4,Data!B2:B1048576,Test!A4,Data!J2:J1048576,"<>"&"")]

nhưng mình muốn sửa lại thành
Mã:
Dim a as Integer, row as Integer
a=1
row = Data.Range("B" &Rows.Count).End(xlUp.Row)

test.Range("C1").Value = [COUNTIFS(Data!E2:E row, Test!B & a ,Data!B2:B row,Test!A & a,Data!J2:J row,"<>"&"")]

được không ạ mình cám ơn rất nhiều
 
Upvote 0
Các bác, các anh chị và các bạn giúp đỡ em về bài này với ạ.
Em có 1 bảng như trong file đính kèm.
Yêu cầu đặt ra như sau: Nhập vào số lượng nhập và số lượng xuất sau đó tính số lượng còn lại.
Nếu số lượng còn lại = 0 thì tô vàng vùng chứa số liệu trong dòng đó còn nếu nhỏ hơn 0 thì chỉ tô màu ô ở cột 5 dòng đó.
Và nếu số lượng xuất bằng rỗng thì để trắng cả dòng đó.
Ví dụ: C2 = 100, nếu D2 = 100 thì tô màu vàng vùng A2:E2, nếu D2 <100 thì tô màu đỏ ô E2 và D2="" thì để trắng vùng A2:E2
Em có viết code VBA như sau nhưng bị lỗi mọi người kiểm tra giúp em với ạ.
Mã:
Dim i As Integer
Dim Vung As Range
Sheets("sheet1").Select
Range("C2").Select
For i = 2 To 11
    If Cells(i, 3) <> Empty Then
        Cells(i, 5).Value = Cells(i, 3).Value - Cells(i, 4).Value
        If Cells(i, 5) = 0 Then
            Set Vung = Range(Cells(i, 1), Cells(i, 5))
            Range("Vung").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Else
            Cells(i, 5).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
         End If
      Else
      Cells(i, 5).Value = Empty
       End If
Next i
 
Upvote 0
Tiếc là không mở được file của bạn; Nó báo lỗi định dạng file sao đó.
 
Upvote 0
Em có 1 file này mà khi em chạy VBA thì dữ liệu ở cột Subtype ( màu xanh ) nó mất luôn. Các anh sửa hộ em vẫn giữ được dữ liệu ở các ô xen kẽ như ví dụ được không. Em cám ơn.
 

File đính kèm

  • Target FINAL.xlsb
    32.2 KB · Đọc: 7
Upvote 0
Em có 1 file này mà khi em chạy VBA thì dữ liệu ở cột Subtype ( màu xanh ) nó mất luôn. Các anh sửa hộ em vẫn giữ được dữ liệu ở các ô xen kẽ như ví dụ được không. Em cám ơn.
Trong Code của bạn không có dArr(K, 4) nên nó vậy
 
Upvote 0
Trong Code của bạn không có dArr(K, 4) nên nó vậy
Anh ơi, em biết ít về VBA lắm, sửa như nào anh sửa hộ em được không ạ ?
Mã:
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, C As Long, R As Long
With Sheets("Roster")
    C = .Range("F2") - .Range("C2") + 6
    sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R * C, 1 To 5)
End With
For I = 5 To R Step 5
    If sArr(I, 1) <> Empty Then
        For J = 6 To C
        K = K + 1
            dArr(K, 1) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(1, J)
            dArr(K, 5) = sArr(I, J)
        Next J
    End If
Next I
With Sheets("IT2003")
    Range("A2").Resize(100000, 5).ClearContents
    If K Then .Range("A2").Resize(K, 5) = dArr
End With
End Sub
 
Upvote 0
Anh ơi, em biết ít về VBA lắm, sửa như nào anh sửa hộ em được không ạ ?
Mã:
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, C As Long, R As Long
With Sheets("Roster")
    C = .Range("F2") - .Range("C2") + 6
    sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R * C, 1 To 5)
End With
For I = 5 To R Step 5
    If sArr(I, 1) <> Empty Then
        For J = 6 To C
        K = K + 1
            dArr(K, 1) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(1, J)
            dArr(K, 5) = sArr(I, J)
        Next J
    End If
Next I
With Sheets("IT2003")
    Range("A2").Resize(100000, 5).ClearContents
    If K Then .Range("A2").Resize(K, 5) = dArr
End With
End Sub
Bạn không khai báo dArr(k,4) thì hệ thống tự hiểu cột số 4 (Sub type) là trống.
Nếu muốn người khác sửa cho, bạn phải cho biết dữ liệu bạn muốn có là gì chứ?
 
Upvote 0
Bạn không khai báo dArr(k,4) thì hệ thống tự hiểu cột số 4 (Sub type) là trống.
Nếu muốn người khác sửa cho, bạn phải cho biết dữ liệu bạn muốn có là gì chứ?
Em chỉ muốn ô đó là ô trống, em tự điền. Nhưng khi em chạy code thì dữ liệu em đã điền bị xóa luôn. Ý là cột 1,2,3 là fill dữ liệu từ code, bỏ cột 4 ( tự điền ), fill cột 5 fill dữ liệu từ code
 
Upvote 0
Web KT
Back
Top Bottom