Chuyên đề giải đáp những thắc mắc về code VBA (5 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 2 (Thành viên: 0, Khách: 2)
maytinhvp01

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:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
thaplang đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
thaplang đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
thaplang đã viết:
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
Nhấp chuột vào đây để mở rộng...
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

Upvote 0
bigbabol89 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Trong Code của bạn không có dArr(K, 4) nên nó vậy
 
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Trong Code của bạn không có dArr(K, 4) nên nó vậy
Nhấp chuột vào đây để mở rộng...
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
bigbabol89 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
vanthinh3101 đã viết:
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ứ?
Nhấp chuột vào đây để mở rộng...
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
bigbabol89 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bạn xem đúng ý không.
Mã: 
Public Sub GPE()
    Dim sArr(), dArr1(), dArr2(), 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 dArr1(1 To R * C, 1 To 3): ReDim dArr2(1 To R * C, 1 To 1)
    End With
    For I = 5 To R Step 5
        If sArr(I, 1) <> Empty Then
            For J = 6 To C
                K = K + 1
                dArr1(K, 1) = sArr(I, 1)
                dArr1(K, 2) = sArr(1, J)
                dArr1(K, 3) = sArr(1, J)
                dArr2(K, 1) = sArr(I, J)
            Next J
        End If
    Next I
    With Sheets("IT2003")
        Range("A2").Resize(100000, 3).ClearContents
        Range("E2").Resize(100000).ClearContents
        If K Then .Range("A2").Resize(K, 3) = dArr1: .Range("E2").Resize(K, 1) = dArr2
    End With
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Bạn xem đúng ý không.
Mã: 
Public Sub GPE()
    Dim sArr(), dArr1(), dArr2(), 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 dArr1(1 To R * C, 1 To 3): ReDim dArr2(1 To R * C, 1 To 1)
    End With
    For I = 5 To R Step 5
        If sArr(I, 1) <> Empty Then
            For J = 6 To C
                K = K + 1
                dArr1(K, 1) = sArr(I, 1)
                dArr1(K, 2) = sArr(1, J)
                dArr1(K, 3) = sArr(1, J)
                dArr2(K, 1) = sArr(I, J)
            Next J
        End If
    Next I
    With Sheets("IT2003")
        Range("A2").Resize(100000, 3).ClearContents
        Range("E2").Resize(100000).ClearContents
        If K Then .Range("A2").Resize(K, 3) = dArr1: .Range("E2").Resize(K, 1) = dArr2
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Thành công mỹ mãn. Em cám ơn anh rất nhiều
 
Upvote 0
Hi cả nhà ạ
Mình có viết đoạn code về tìm kiếm trong Combobox như sau:

Dim i As Long
For i = 1 To Application.WorksheetFunction.CountA(Main.Range("F:F"))
If LCase(Left(Main.Cells(i, 1), 1)) = Me.ComboBox1 And Me.ComboBox1 <> "" Then
Me.ComboBox1.AddItem Main.Cells(i, 1)
End If
Next i
Me.ComboBox1.DropDown
With Me
.txtdi.Value = .ComboBox1.List(.ComboBox1.ListIndex, 1)
End With
End Sub

nhưng khi bấm seach thì không hiện ra như mong muốn, chỉ viết tìm kiếm được có một chữ đến 2 chữ cái chứ không viết nhiều được ạ, và viết xong không bấm nút xoá được.
Trong Combobox mình để có 2 cột
Mong cả nhà giúp đỡ ạ
 
Upvote 0
Cho mình hỏi code:
Mã: 
Range("$C$3:$C$1734").AutoFilter Field:=1, Criteria1:="*" & Range("C1").Value & "*", Operator:=xlFilterValues
Nghĩ là gì vậy
 
Upvote 0
Cho em hỏi đoạn code em viết này sao nó chậm thế, có cách nào cho nhanh hơn không ạ
 

File đính kè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

C
  • Question Question
Xin hỏi Cách viết chú thích trong vba hiển thị tiếng việt (1 người xem)
Trả lời
4
Đọc
130
ongke0711
ongke0711
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước. (1 người xem)
    • Thích
2
Trả lời
28
Đọc
7K
Hoàng Tuấn 868
H
G
Xin Code xóa Module.
Trả lời
8
Đọc
273
huhumalu
H
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
3
Đọc
146
tle2003
T
D
  • Đã giải quyết
Quản lý email outlook qua VBA cần giúp đỡ
2
Trả lời
22
Đọc
545
nguyendang95
N
S
Mở 2 cửa sổ riêng biệt
2
Trả lời
30
Đọc
23K
sakuraluu
S
F
Nhập dấu . (chấm) ở bàn phím phụ không tự chuyển thành dấu , (phẩy)
Trả lời
16
Đọc
57K
tubaodn21
tubaodn21
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
21
Đọc
1K
PhanTuHuong
PhanTuHuong
L
Lỗi font khi convert từ pdf
Trả lời
3
Đọc
138
lamvu0677
L
N
Khắc phục lỗi "The picture is too large and will be truncated" (1 người xem)
Trả lời
9
Đọc
5K
SonBDND
S
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (1 người xem)
    • Thích
Trả lời
0
Đọc
2K
GPE-Trợ Lý
GPE-Trợ Lý
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table (1 người xem)
Trả lời
1
Đọc
123
khkkh
K
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
798
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
228
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
0
Đọc
148
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
138
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel (1 người xem)
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
14
Đọc
223
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
712
thuytrangbp28
T
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
241
Hoàng Tuấn 868
H
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
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom