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

maytinhvp01 · 31/7/13

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]

doveandrose · 12/12/16

khuongvietphong đã viết:

Nói chung mọi người giải thích sơ qua về đoạn code này giúp e vs được không ạ:

Mã:

Sub SplitFile(rptTitle As String, fileName As String, path As String)
    
    Range("B2") = rptTitle

    Sheets(Array("Sheet1")).Select  
    Sheets(Array("Sheet1")).Copy  [COLOR=#ff0000][B] ' Chỗ này Copy xong nhưng không thấy Paste vô đâu cả  ... ????'[/B][/COLOR]
    
    Range("E7:F8").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs fileName:=path & "\" & fileName & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    
    Application.DisplayAlerts = True
    ActiveWindow.Close
  
End Sub

bạn xóa hết tất cả các dòng từ sau lệnh

Mã:

Sheets(Array("Sheet1")).Copy

trở xuống là biết ngay nó copy đi đâu thôi mà .

tueyennhi · 12/12/16

Em nhờ mọi người dịch cho em đoạn code này ạ:

Option Explicit

Public Sub GPE()
Dim Dic As Object, Ws As Worksheet, sArr(), dArr(1 To 100, 1 To 4)
Dim I As Long, J As Long, K As Long, Rws As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
If Ws.Name <> "Data" Then
sArr = Ws.Range("A4", Ws.Range("A4").End(xlDown)).Resize(, 5).Value
For I = 1 To UBound(sArr)
Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 5)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, 2)
dArr(K, 4) = sArr(I, 5)
End If
Rws = Dic.Item(Tem)
dArr(Rws, 3) = dArr(Rws, 3) + sArr(I, 4)
Next I
End If
Next Ws
With Sheets("Data")
.Range("C5:F100").ClearContents
.Range("C5:F5").Resize(K) = dArr
.Range("A5:F5").Resize(K).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub

Em cảm ơn!

doveandrose · 12/12/16

tueyennhi đã viết:
Em nhờ mọi người dịch cho em đoạn code này ạ:

Option Explicit

Public Sub GPE()
Dim Dic As Object, Ws As Worksheet, sArr(), dArr(1 To 100, 1 To 4)
Dim I As Long, J As Long, K As Long, Rws As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
If Ws.Name <> "Data" Then
sArr = Ws.Range("A4", Ws.Range("A4").End(xlDown)).Resize(, 5).Value
For I = 1 To UBound(sArr)
Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 5)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, 2)
dArr(K, 4) = sArr(I, 5)
End If
Rws = Dic.Item(Tem)
dArr(Rws, 3) = dArr(Rws, 3) + sArr(I, 4)
Next I
End If
Next Ws
With Sheets("Data")
.Range("C5:F100").ClearContents
.Range("C5:F5").Resize(K) = dArr
.Range("A5:F5").Resize(K).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub

Em cảm ơn!

đang hỏi ở đây thì cứ vào đây mà hỏi

http://www.giaiphapexcel.com/forum/...Tìm-hiểu-về-mảng-qua-code&p=757119#post757119

khuongvietphong · 14/12/16

doveandrose đã viết:
bạn xóa hết tất cả các dòng từ sau lệnh

Mã:

Sheets(Array("Sheet1")).Copy

trở xuống là biết ngay nó copy đi đâu thôi mà .

Cảm ơn anh đẹp trai ạ :"'

vipvphvtc · 15/12/16

Mình mới tập học VBA, có đoạn sub như này:

Sub testlap()
Dim i As Integer
Dim n, m As Integer
Dim Dir As String
Dim MyPath As String
Dim bc As String

Application.ScreenUpdating = False

Dir = Application.ActiveWorkbook.Path & ""

For i = 1 To 10
bc = "BC" & i & ".xls"
MyPath = Dir & bc

Workbooks.Open MyPath

Application.Goto Workbooks("Tong hop.xlsm").Worksheets("KetQua").Range("B7")
Range(Selection, Selection.End(xlDown)).Select
m = Selection.Count
If m = 2 Then
m = 0
Else
m = Selection.Count
End If

Application.Goto Workbooks(bc).Worksheets("KQ").Range("B1")
Range(Selection, Selection.End(xlDown)).Select
n = Selection.Count
Workbooks(bc).Worksheets("KQ").Range(Cells(2, 2), Cells(n, 13)).Copy Destination:=Workbooks("Tong hop.xlsm").Worksheets("KetQua").Cells(m + 9, 2)
Application.Goto Workbooks("Tong hop.xlsm").Worksheets("KeHoach").Range("B7")
Range(Selection, Selection.End(xlDown)).Select
m = Selection.Count
If m = 2 Then
m = 0
Else
m = Selection.Count
End If
Application.Goto Workbooks(bc).Worksheets("KH").Range("B1")
Range(Selection, Selection.End(xlDown)).Select
n = Selection.Count
Workbooks(bc).Worksheets("KH").Range(Cells(2, 2), Cells(n, 13)).Copy Destination:=Workbooks("Tong hop.xlsm").Worksheets("KeHoach").Cells(m + 9, 2)
Workbooks(bc).Close
Next

End Sub

Mình muốn copy dữ liệu trong 2 sheet KQ và KH từ các file riêng lẻ BC1.xls, BC2.xls...., BC10.xls vào 2 sheet tương ứng "KetQua" và "KeHoch" trong file "Tong hop.xlsm",
Nhưng như mình test thử thì giá trị m của mình luôn =2 với mọi i, làm cho dữ liệu paste vào file Tong hop luôn bắt đầu từ ô B9, mà mình muốn dữ liệu file BC1.xls bắt đầu dán vào ô B9, xong dữ liệu từ BC2.xls dán vào dòng tiếp theo dữ liệu đã có từ BC1.xls.
Mình không hiểu tại sao m lại luôn =2, mong mọi người giúp với ạ.

View attachment Tong hop.xlsm
View attachment BC1.xls

ku_ri · 15/12/16

em có 1 file excel như file đính kèm, mục đích là em muốn đếm số dòng CÓ SỐ ở cột F của mỗi sheet (không đếm dòng có chữ) và tổng hợp theo tên của sheet để cho ra kết quả như sheet tổng hợp, em có khoảng 20 sheet, mỗi sheet có thể có đến 1000 dòng, mọi người giúp em với ạ, hoặc mọi người làm giúp em code để copy cột F ở sheet 1 -> cột A ở sheet TongHop, tương tự cột F ở quý 2 -> cột B ở sheet TongHop,.....rồi em tự count cũng được ạ, cảm ơn mọi người. Em có coi những bài tổng hợp sheet cũ nhưng không có cái nào áp dụng được như mục đích.

Tuan_hcth · 15/12/16

Nhờ các anh chị trên diễn đàn giải nghĩa đoạn Code sau với ạ

Function FileNameList(FolPath As String)
On Error Resume Next
FolPath = FolPath & ""
ActiveWorkbook.Names.Add "Arr", "=""" & FolPath & """&Files(""" & FolPath & "*.xls"")"
FileNameList = Evaluate("Arr")
ActiveWorkbook.Names("Arr").Delete
End Function

HieuCD · 15/12/16

ku_ri đã viết:
em có 1 file excel như file đính kèm, mục đích là em muốn đếm số dòng CÓ SỐ ở cột F của mỗi sheet (không đếm dòng có chữ) và tổng hợp theo tên của sheet để cho ra kết quả như sheet tổng hợp, em có khoảng 20 sheet, mỗi sheet có thể có đến 1000 dòng, mọi người giúp em với ạ, hoặc mọi người làm giúp em code để copy cột F ở sheet 1 -> cột A ở sheet TongHop, tương tự cột F ở quý 2 -> cột B ở sheet TongHop,.....rồi em tự count cũng được ạ, cảm ơn mọi người. Em có coi những bài tổng hợp sheet cũ nhưng không có cái nào áp dụng được như mục đích.

bạn chạy thử code

Mã:

Sub DemSo()
Dim Darr(), Arr(), i As Long, k As Integer, s As Integer
ReDim Arr(1 To Sheets.Count, 1 To 2)
For s = 1 To Sheets.Count
    If Sheets(s).Name = "TongHop" Then GoTo tiep
    k = k + 1:  Arr(k, 1) = Sheets(s).Name: Arr(k, 2) = 0
    If Sheets(s).Range("F65500").End(xlUp).Row < 3 Then GoTo tiep
    Darr = Sheets(s).Range("F3:F" & Sheets(s).Range("F65500").End(xlUp).Row).Value
    For i = 1 To UBound(Darr)
        If IsNumeric(Darr(i, 1)) And Darr(i, 1) <> "" Then Arr(k, 2) = Arr(k, 2) + 1
    Next i
tiep:
Next s
Sheets("TongHop").Range("B4:C1000").ClearContents
Sheets("TongHop").Range("B4").Resize(k, 2) = Arr
End Sub

ku_ri · 16/12/16

HieuCD đã viết:

bạn chạy thử code

Mã:

Sub DemSo()
Dim Darr(), Arr(), i As Long, k As Integer, s As Integer
ReDim Arr(1 To Sheets.Count, 1 To 2)
For s = 1 To Sheets.Count
    If Sheets(s).Name = "TongHop" Then GoTo tiep
    k = k + 1:  Arr(k, 1) = Sheets(s).Name: Arr(k, 2) = 0
    If Sheets(s).Range("F65500").End(xlUp).Row < 3 Then GoTo tiep
    Darr = Sheets(s).Range("F3:F" & Sheets(s).Range("F65500").End(xlUp).Row).Value
    For i = 1 To UBound(Darr)
        If IsNumeric(Darr(i, 1)) And Darr(i, 1) <> "" Then Arr(k, 2) = Arr(k, 2) + 1
    Next i
tiep:
Next s
Sheets("TongHop").Range("B4:C1000").ClearContents
Sheets("TongHop").Range("B4").Resize(k, 2) = Arr
End Sub

Em đã chạy thử và thành công, cảm ơn bác nhiều nhé

minhtuan91 · 1/1/17

Em chào các anh.
Em muốn bỏ lọc và fomat dữ liệu ở tất cả các sheet thì code như thế nào ạ. Em cảm ơn mọi người.

HieuCD · 1/1/17

minhtuan91 đã viết:
Em chào các anh.
Em muốn bỏ lọc và fomat dữ liệu ở tất cả các sheet thì code như thế nào ạ. Em cảm ơn mọi người.

bạn chạy code

Mã:

Sub GPE()
Dim k As Byte
For k = 1 To Worksheets.Count
    Sheets(k).Cells.ClearFormats
Next k
End Sub

befaint · 1/1/17

................................

minhtuan91 · 1/1/17

HieuCD đã viết:
bạn chạy code

Mã:

Sub GPE() Dim k As Byte For k = 1 To Worksheets.Count Sheets(k).Cells.ClearFormats Next k End Sub

Em cảm ơn anh nhé. Em chạy Code đã ok.

minhtuan91 · 7/1/17

Em chào cả nhà. Hiện em đang mới học VBA em nhờ code giúp em file đính kèm.
Em muốn viết code tự động dò danh mục kho mà chưa biết chính xác dữ liệu có bao nhiêu dòng.
Và nếu như bị NA thìbáo lỗi bằng MsgBox nội dung" Thiếu DM17 " và kết thúc Sub luôn lập tức. Em cảm ơn.

befaint · 7/1/17

minhtuan91 đã viết:
Em chào cả nhà. Hiện em đang mới học VBA em nhờ code giúp em file đính kèm.
Em muốn viết code tự động dò danh mục kho mà chưa biết chính xác dữ liệu có bao nhiêu dòng.
Và nếu như bị NA thìbáo lỗi bằng MsgBox nội dung" Thiếu DM17 " và kết thúc Sub luôn lập tức. Em cảm ơn.

Bạn xem file đính kèm.

minhtuan91 · 7/1/17

befaint đã viết:
Bạn xem file đính kèm.

ý của em là tự động chạy công thức dò tìm nếu bị NA thì báo lỗi và kết thúc sub . Chứ không phải mình có sẵn dữ liệu đã dò tìm. bác Code giúp em nhé

befaint · 7/1/17

minhtuan91 đã viết:
ý của em là tự động chạy công thức dò tìm nếu bị NA thì báo lỗi và kết thúc sub . Chứ không phải mình có sẵn dữ liệu đã dò tìm. bác Code giúp em nhé

Nghĩa là sao? Hàm vlookup đã thỏa mãn cái chỗ màu đỏ rồi. Code mần chi nữa?

minhtuan91 · 7/1/17

befaint đã viết:
Nghĩa là sao? Hàm vlookup đã thỏa mãn cái chỗ màu đỏ rồi. Code mần chi nữa?

Em muốn code như sau:
Ô c5 chạy công thức +VLOOKUP(B5;DM!A:B;2;0)
Sau đó tự động chạy Công thức ở cột C nhưng nếu bị NA thì báo lỗi và dừng sub lại

befaint · 7/1/17

minhtuan91 đã viết:
Em muốn code như sau:
Ô c5 chạy công thức +VLOOKUP(B5;DM!A:B;2;0)
Sau đó tự động chạy Công thức ở cột C nhưng nếu bị NA thì báo lỗi và dừng sub lại

Cũng muốn cố giúp bạn nhưng không hiểu được bạn muốn gì...
Chạy công thức ở cột C là chạy như nào?
Công thức ở cột C sau khi nhập xong nếu có lỗi thì nó báo lỗi cho mình biết luôn rồi.
Dừng sub? yêu cầu cái sub đó thực hiện gì để dừng nó khi gặp #N/A ở cột C.
Ngoài ra, bạn không nên viết VLOOKUP(B5;DM!A:B;2;0) vùng tìm kiếm cả cột như thế, máy tính sẽ không kham nổi. Dữ liệu tới đâu thì chọn tới vùng đó thôi

Mã:

=VLOOKUP(B5,DM!$A$4:$B$9,2,0)

minhtuan91 · 7/1/17

Em cảm ơn bác Befaint nhé. Em theo Code của bác để vận dụng vào file của em đã ok rồi.

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

Thành viên thường trực

hello

Thành viên tích cực

hello

Be all you can be !

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thành viên thường trực

Chuyên gia GPE

Thành viên mới

Thành viên mới

Chuyên gia GPE

|||||||||||||

Thành viên mới

Thành viên mới

File đính kèm

|||||||||||||

File đính kèm

Thành viên mới

|||||||||||||

Thành viên mới

|||||||||||||

Thành viên mới

Facebook

Group