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

Liên hệ QC
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
VetMini đã viết:
Bạn biết mục đích code ấy nó làm cái gì hôn? (không đi theo cái file áp dụng thì mục đích rỗng tuếch)
Người viết code lúc ấy chỉ có 1 mục đích chính trong đầu: từ dữ kiện đầu vào như thế, đạt yêu cầu đầu ra như này, với tốc độ nhanh nhất. Hết.
Nó không phải là loại code viết để người khác tìm hiểu và học hỏi.
Nhấp chuột vào đây để mở rộng...
mình đã kèm file theo đính kèm, mình vẫn ko hiểu ý bạn. ( Nó không phải là loại code viết để người khác tìm hiểu và học hỏi. ). Mình biết nó cao siêu, nhưng ko biết thì mĩnh vẫn hỏi tại nó cần cho công việc của mình..Thank bạn đã góp ý
 
Upvote 0
nguyenthotnot đã viết:
Chào các anh chị: Em có đoạn code của GPE em mới đang học VBA em coppy đoạn code về phục vụ cho công việc của em nhưng em vẫn ko hiểu ý nghĩa của các đoạn code sau mong các anh chị có thể giải thích cặn kẽ giúp em với tại sao mình khai báo là biến sArr() và dArr(), fDate, eDate, Rws, Col, với các mục tô màu đỏ mong các anh chị giúp em hiểu ý nghĩa với thank các anh chị biến J,K,R mình có thể khai báo biến khác được ko các anh chị
Public Sub Gpe_Loc()
Dim sArr(), dArr(), i As Long, J As Long, K As Long, R As Long, Rws As Long, Col As Long, fDate As Long, eDate As Long, SName As String
SName = Range("C5").Value
fDate = Range("C6").Value
eDate = IIf(Range("C7").Value = Empty, Date, Range("C7").Value)
sohd = "*" & UCase(Range("E6").Value) & "*"
Col = 57
With Sheets(SName)
R = .Range("B10000").End(xlUp).Row
If R > 8 Then
sArr = .Range("A9:A" & R).Resize(, Col).Value
Rws = UBound(sArr)
ReDim dArr(1 To R, 1 To Col)
For i = 1 To Rws
If sArr(i, 2) >= fDate Then
If sArr(i, 2) <= eDate Then
If UCase(sArr(i, 3)) Like UCase(sohd) Then
K = K + 1
dArr(K, 1) = K
For J = 2 To Col
dArr(K, J) = sArr(i, J)
Next J
End If
End If
End If
End With
Range("A9").Resize(1000, Col).ClearContents
If K Then Range("A9").Resize(K, Col) = dArr
End Sub

public Sub Gpe_TH()
Dim sArr(), dArr(), Col(), tArr(), Ngay As Date, ShName As String
Dim C As Long, i As Long, J As Long, K As Long, n As Long, R As Long, Rws As Long
Ngay = Range("C4").Value
Col = Range("D8:Z8").Value
C = UBound(Col, 2)
tArr = Range("C9", Range("C9").End(xlDown)).Value
ReDim dArr(1 To UBound(tArr), 1 To C)
For n = 1 To UBound(tArr)
ShName = tArr(n, 1)
With Sheets(ShName)
R = .Range("B50000").End(xlUp).Row
If R > 8 Then
sArr = .Range("A9:B" & R).Resize(, 57).Value
Rws = UBound(sArr)
For i = Rws To 1 Step -1
If sArr(i, 2) <= Ngay Then
For J = 1 To C
If Col(1, J) <> Empty Then dArr(n, J) = sArr(i, Col(1, J))
Next J
Exit For
End If
Next i
End If
End With
Next n
Range("D9").Resize(1000, C).ClearContents
Range("D9").Resize(n - 1, C) = dArr
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$4" Then Gpe_TH
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C5:K7")) Is Nothing Then Gpe_Loc
End Sub

em xin kèm theo file đính kèm mong các anh chị chỉ giúp đỡ dùm
Nhấp chuột vào đây để mở rộng...
Đến biến bạn còn không biết ý nghĩa của nó thì làm sao mà hiểu được code.Bạn phải hiểu cơ bản rồi mới tìm hiểu thêm.Bạn đọc tài liệu mảng xong vào tìm hiểu code này nhé.
 
Upvote 0
Nhờ các bạn giúp mình sửa lỗi trong file này với ah, chạy VBA báo lỗi mình chưa biết xử lý thế nào, thanks
 

File đính kèm

Upvote 0
luanvm123 đã viết:
Nhờ các bạn giúp mình sửa lỗi trong file này với ah, chạy VBA báo lỗi mình chưa biết xử lý thế nào, Cảm ơn
Nhấp chuột vào đây để mở rộng...
Thêm câu lệnh này nữa.Đó trước câu ở dưới.
Mã: 
Sheet2.Activate
 Sheet2.Range(Cells(3, 4 + 28 * (a - 1)), Cells(3, 28 * a + 4)) = "T" & a
 
Upvote 0
Gửi các anh chị. Em mới tự học và làm thử code trên file excel công việc của em. Có đoạn code tự làm này mà không hiểu sao nó làm file của em tính toán chậm quá ạ. Mọi người giúp em khắc phục được không ạ
Nhập tháng làm việc
Mã: 
Private Sub Workbook_Open()
Dim thang As Integer
Dim nam As Integer
Application.Calculation = xlCalculationManual
On Error Resume Next
thang = InputBox("chon thang lam viec", , Month(Date))
On Error GoTo 0
Sheets("th").Range("y1").Value = thang
If thang > 12 Or thang <= 0 Then
   MsgBox "Chua chon thang", vbCritical
   Sheets("th").Range("y1").Value = Month(Date)
End If
On Error Resume Next
nam = InputBox("chon nam lam viec", , Year(Date))
On Error GoTo 0
Sheets("th").Range("z1").Value = nam
If nam <= 2007 Then
   MsgBox "Chua chon nam", vbCritical
   Sheets("th").Range("z1").Value = Year(Date)
End If
Application.Calculation = xlCalculationAutomatic
End Sub
Module1:
Mã: 
Function thanglmv() As Date
Application.Volatile
thanglmv = DateSerial(Sheets("th").Range("z1").Value, Sheets("th").Range("y1").Value, 15)
End Function
Code này em dùng để nhập tháng làm việc sau đó lấy hàm lấy ngày tháng làm việc đó dùng trong công thức khoảng 300 dòng.
 
Upvote 0
Xin giúp đỡ về vòng lặp For..Next
Mã: 
Sub tinhdinhluong()
Dim i, j, a, b
For i = 4 To 1500 'lay ten model sheet B.O.M
     For a = 6 To 50 'so sanh ten model o sheet 8
         For j = 4 To 1500 'lay code o sheet B.O.M
             For b = 7 To 650
              If Sheet2.Cells(i, 2).Value = Sheet8.Cells(5, a).Value And Sheet2.Cells(j, 3).Value = Sheet8.Cells(b, 3).Value Then
              Sheet8.Cells(b, a).Value = Sheet2.Cells(j, 9).Value
              End If
             Next b
         Next j
     Next a
Next i
End Sub
sau khi em chạy thì file bị dow, xin các anh chị giúp đỡ ạ
 
Upvote 0
duonghychi đã viết:
Xin giúp đỡ về vòng lặp For..Next
Mã: 
Sub tinhdinhluong()
Dim i, j, a, b
For i = 4 To 1500 'lay ten model sheet B.O.M
     For a = 6 To 50 'so sanh ten model o sheet 8
         For j = 4 To 1500 'lay code o sheet B.O.M
             For b = 7 To 650
              If Sheet2.Cells(i, 2).Value = Sheet8.Cells(5, a).Value And Sheet2.Cells(j, 3).Value = Sheet8.Cells(b, 3).Value Then
              Sheet8.Cells(b, a).Value = Sheet2.Cells(j, 9).Value
              End If
             Next b
         Next j
     Next a
Next i
End Sub
sau khi em chạy thì file bị dow, xin các anh chị giúp đỡ ạ
Nhấp chuột vào đây để mở rộng...
Theo kết quả mình tính sơ bộ thì cần:63.317.948.672 vòng lặp để chạy xong 4 vòng lặp For của bạn chưa tính đến chuyện sử lý số liệu.Máy nó chạy cũng hết hơi.
​
 
Upvote 0
duonghychi đã viết:
em muốn ở sheet "CHIA BTP" sẽ lấy giá trị ở cột "QTY" tại sheet B.O.M ạ, xin bác giúp đỡ
Nhấp chuột vào đây để mở rộng...
Bạn thử nhé.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F7:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
 
Upvote 0
snow25 đã viết:
Bạn thử nhé.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F7:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn ạ, bác giúp em 1 xíu nữa là em muốn nhân các giá trị tìm kiếm được cho số lượng ở dòng 6, dưới mỗi tên model thì làm như thế nào ạ.
 
Upvote 0
duonghychi đã viết:
Em cảm ơn ạ, bác giúp em 1 xíu nữa là em muốn nhân các giá trị tìm kiếm được cho số lượng ở dòng 6, dưới mỗi tên model thì làm như thế nào ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thử.
Mã: 
Sub tinh()
    Dim arr, i As Long, j As Long, data, lr As Long, dic As Object, a As Long, b As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("CHIA BTP")
         lr = .Range("C" & Rows.Count).End(xlUp).Row
         If lr < 7 Then Exit Sub
         .Range("F6:AJ" & lr).ClearContents
         arr = .Range("C4:AJ" & lr).Value
         For i = 4 To UBound(arr)
             dk = arr(i, 1) & "#" & "I"
             dic.Item(dk) = i
         Next i
         For i = 4 To UBound(arr, 2)
             dk = arr(2, i) & "#" & "M"
             dic.Item(dk) = i
         Next i
   End With
   With Sheets("B.O.M")
      j = .Range("B" & Rows.Count).End(xlUp).Row
      data = .Range("B4:I" & j).Value
      For i = 1 To UBound(data)
              dk = data(i, 1) & "#" & "M"
              a = dic.Item(dk)
              If a Then
                 dk = data(i, 2) & "#" & "I"
                 b = dic.Item(dk)
                 If b Then
                    arr(b, a) = arr(b, a) + data(i, 8)
                    If data(i, 8) <> 0 Then If arr(3, a) = 0 Then arr(3, a) = data(i, 8) Else arr(3, a) = arr(3, a) * data(i, 8)
                 End If
             End If
     Next i
  End With
  With Sheets("CHIA BTP")
       .Range("C4:AJ" & lr).Value = arr
  End With
End Sub
 
Upvote 0
Code lỗi rồi ạ, bác có thể insert ý định của mỗi biến không ạ, em muốn hiểu được code của bác, :D
 
Upvote 0
Dạ nhờ các anh chị giúp đỡ e với ạ.
file 1 và file 2 có cùng 1 kiểu dữ liệu. Nhưng khi load vào file baocao thì chỉ có mỗi file 1 khi load vào thì cột E sheet data có dữ liệu, còn file 2 thì không có. E ngồi xem code cả chiều rồi mà vẫn không hiểu lý do tại sao load file 2 vào thì cột E không có dữ liệu.
Rất mong anh chị xem qua giúp e với ạ
Em chỉ đoán có gì đó sai trong đoạn

Mã: 
If Len(arrtam) >= 131 And Len(arrtam) < 160 Then
                kq(i, 1) = Trim(Left(arrtam, 17))
                kq(i, 2) = Trim(Mid(arrtam, 18, 4))
                kq(i, 3) = Val(Trim(Mid(arrtam, 22, 15)))
                kq(i, 4) = Trim(Mid(arrtam, 37, 50))
                kqtam = Trim(Mid(arrtam, 40, 150))
                kqtam1 = Trim(Replace(Trim(Mid(kqtam, InStrRev(kqtam, " ") - 21, 21)), ".", ""))
                If IsNumeric(kqtam1) Then
                    kq(i, 6) = Trim(Replace(Trim(Mid(kqtam, InStrRev(kqtam, " ") - 35, 35)), ".", ""))
                Else
                    vitri = InStrRev(kqtam, " ", Len(kqtam) - 41)
                    kq(i, 5) = Trim(Replace(Mid(kqtam, vitri, 20), ".", ""))
                End If
                If Right(arrtam, 1) = "-" Then
                    kq(i, 7) = "-" & Trim(Replace(Replace(Right(kqtam, Len(kqtam) - InStrRev(kqtam, " ")), ".", ""), "-", ""))
                Else
                    kq(i, 7) = Trim(Replace(Right(kqtam, Len(kqtam) - InStrRev(kqtam, " ")), ".", ""))
                End If
            End If
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
xin chào mọi người
Mình có một vấn đề mong mọi người giúp :
Mình muốn tạo 1 nút bấm : mà nếu bấm lần 1 sẽ ẩn các sheet chỉ định trong exel, ấn lần 2 sẽ hiển lại
Hiện tại mình chỉ có thể tạo 2 nút bấm với 2 lệnh này.
mình đã search tìm hiểu nhưng chưa được !
 
Upvote 0
lehuuhaint đã viết:
xin chào mọi người
Mình có một vấn đề mong mọi người giúp :
Mình muốn tạo 1 nút bấm : mà nếu bấm lần 1 sẽ ẩn các sheet chỉ định trong exel, ấn lần 2 sẽ hiển lại
Hiện tại mình chỉ có thể tạo 2 nút bấm với 2 lệnh này.
mình đã search tìm hiểu nhưng chưa được !
Nhấp chuột vào đây để mở rộng...
Bạn giải thích rõ ra chứ.Và có file với code.Mọi người còn biết.Sheets chỉ định ẩn thì nó cố định hay là thay đổi thường xuyên.
 
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

tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác
Trả lời
1
Đọc
23
hoangtuaotrang_hp_vn
H
L
Xin được cách hướng dẫn toán lớp 2
Trả lời
11
Đọc
159
anhtuanle123
A
L
Viết phần mềm đánh lô bằng Visual Basic
    • Thích
2 3
Trả lời
56
Đọc
104K
anhtuanle123
A
vc_đi chơi
Lỗi "####" trong ô khi in
    • Thích
Trả lời
1
Đọc
34
HUONGHCKT
H
A
Kính nhờ xử lý nhập công thức hàm IF kết hợp nhiều điều kiện
Trả lời
2
Đọc
46
tieutuvodanh192
tieutuvodanh192
K
  • Question Question
BÀI TOÁN TÌM GIÁ USD VÀ TÌM LƯỢNG KG - NHỜ ANH/CHỊ GIÚP ĐỠ
    • Chấp nhận
Trả lời
14
Đọc
187
CHAOQUAY
C
nghiahandsome1995
  • Question Question
in đậm chuỗi văn bản bằng excel
Trả lời
2
Đọc
52
HUONGHCKT
H
TKT
In đậm trong công thức ghép chuỗi
2
Trả lời
28
Đọc
51K
nghiahandsome1995
nghiahandsome1995
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
316
Đọc
23K
kunkoi9390
K
S
Lỗi Path/File access error:'.\VBFB.tmp'
Trả lời
11
Đọc
4K
HeSanbi
HeSanbi
G
Dấu = trong excel bị đảo ngược từ trước ra sau
Trả lời
3
Đọc
35
vanle33
vanle33
T
Lỗi ngắt chữ khi xuống dòng
Trả lời
1
Đọc
24
HeSanbi
HeSanbi
Mewwo98
Cách chạy Add-in khi khởi động excel
Trả lời
7
Đọc
95
tigertiger
tigertiger
N
Thử viết code lập trình đa luồng bằng TwinBasic và khả năng ứng dụng vào COM add-in chạy trong Excel
    • Thích
Trả lời
3
Đọc
317
nguyendang95
N
K
Mở file Excell lên bị lỗi run-time error 76' path not found
Trả lời
0
Đọc
29
kunkoi9390
K
tuankieu28
Hướng dẫn hàm tìm thông tin
Trả lời
0
Đọc
33
tuankieu28
tuankieu28
Momominh
Hỏi công thức tìm kiếm
Trả lời
2
Đọc
47
thuytrangbp28
T
huongmuine
Điền số thứ tự theo nhóm có điều kiện
Trả lời
4
Đọc
70
huongmuine
huongmuine
Mewwo98
Thay dấu ngăn cách sau chữ số hàng nghìn, hàng triệu, hàng tỷ trong Mail Merge
Trả lời
12
Đọc
246
HeSanbi
HeSanbi
H
Nhờ các bạn mở quá công thức của các sheet
Trả lời
3
Đọc
74
VetMini
V
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
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom