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:
- Nên nghĩ bạn nên dùng vòng lặp For để chạy qua các Sheet.
- Kiểm tra tình trạng bảng tính Có Filter hay không?
- Nếu có thì tiến hành ShowAllData như bạn muốn, còn không thì bỏ qua.
Bạn viết giúp mình code dùng vòng lặp for đó được ko Bạn? Tks Bạn!
 
Upvote 0
Bạn viết giúp mình code dùng vòng lặp for đó được ko Bạn? Tks Bạn!


PHP:
Sub ShowAll_Data()
    On Error Resume Next
    Dim AuF As AutoFilter
    Dim Wks As Worksheet
    For Each Wks In Worksheets
        Wks.Select
        Set AuF = Wks.AutoFilter
        If AuF.FilterMode = True Then
            Wks.ShowAllData
        End If
    Next Wks
End Sub
- Bạn chép vào Module-->Ra ngoài bảng tính-->alt+F8-->Run xem thế nào.
 
Upvote 0
Em chào A/C!
Em đang tạo code để Clear filter một loạt các sheets trong file, đang ở chế độ filter. Hiện tại nếu các sheet đều filter thì code chạy được. Nhưng nếu sheet nào đó ko filter thì code bị lỗi và dừng lại. A/C sửa hoặc bổ sung giúp Em cách bẫy lỗi trường hợp ko Filter thì next sang các sheet tiếp theo. Cảm ơn A/C nhiều!

Mã:
Sub ClearAllSheet()
On Error Resume Next
Sheet16.Select ActiveSheet.ShowAllData
Sheet2.Select ActiveSheet.ShowAllData
Sheet4.Select ActiveSheet.ShowAllData
Sheet5.Select ActiveSheet.ShowAllData
Sheet6.Select ActiveSheet.ShowAllData
Sheet9.Select ActiveSheet.ShowAllData
Sheet13.Select ActiveSheet.ShowAllData
Sheet14.Select ActiveSheet.ShowAllData
Sheet15.Select ActiveSheet.ShowAllData
Sheet16.Select ActiveSheet.ShowAllData
Sheet17.Select ActiveSheet.ShowAllData
Sheet19.Select ActiveSheet.ShowAllData
Sheet21.Select ActiveSheet.ShowAllData
Sheet22.Select ActiveSheet.ShowAllData
End Sub
thử code
Mã:
Sub ClearAllSheet()
On Error Resume Next
For i = 1 To Sheets.Count
  Sheets(i).ShowAllData
Next i
End Sub
 
Upvote 0
PHP:
Sub ShowAll_Data()
    On Error Resume Next
    Dim AuF As AutoFilter
    Dim Wks As Worksheet
    For Each Wks In Worksheets
        Wks.Select
        Set AuF = Wks.AutoFilter
        If AuF.FilterMode = True Then
            Wks.ShowAllData
        End If
    Next Wks
End Sub
- Bạn chép vào Module-->Ra ngoài bảng tính-->alt+F8-->Run xem thế nào.


thử code
Mã:
Sub ClearAllSheet()
On Error Resume Next
For i = 1 To Sheets.Count
  Sheets(i).ShowAllData
Next i
End Sub


Em chạy code rồi, Rất tuyệt.
Cảm ơn Bạn phuyen89 và Anh HieuCD rất nhiều!
 
Upvote 0
Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
End Sub

Code này em dùng để copy sheet Form, tuy nhiên vì sheet này của em đang ẩn nên khi chạy lệnh này cũng tạo ra Sheet ẩn. Vậy làm thế nào để sheet mới được tạo ra sẽ hiện?
 
Upvote 0
Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
End Sub

Code này em dùng để copy sheet Form, tuy nhiên vì sheet này của em đang ẩn nên khi chạy lệnh này cũng tạo ra Sheet ẩn. Vậy làm thế nào để sheet mới được tạo ra sẽ hiện?
Bạn thử:
PHP:
Public Sub Hoi_sinh()
     Sheets("Form").Visible = True
  Sheets("Form").Copy After:=Sheets("Form")
    Sheets("Form").Visible = False
End Sub
 
Upvote 0
Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
End Sub

Code này em dùng để copy sheet Form, tuy nhiên vì sheet này của em đang ẩn nên khi chạy lệnh này cũng tạo ra Sheet ẩn. Vậy làm thế nào để sheet mới được tạo ra sẽ hiện?
PHP:
Public Sub Hoi_sinh()
Sheets("Form").Copy After:=Sheets("Form")
Sheets(Sheets("Form").Index + 1).Visible = True
End Sub
 
Upvote 0
E có 1 vấn đề này mong các bác giúp:
E có 1 File Access xuất ra từ phần mềm Etabs có đuôi “*.mdb” và 1 File Excel. E muốn nhập dữ liệu từ File “*.mdb” vào các Sheets của File Excel. E dùng chức năng Recorder macro để mò Code thì e được 1 đoạn Code miêu tả quá trình nhập dữ liệu từ File “*.mdb” vào 1 Sheet của File Excel trên.
Nhưng vấn để nảy sinh là: Cái “Data Source” nó lại là cố định ứng với vị trí e để File “*.mdb” đó. Bác nào viết giúp e đoạn Code để e gán vào 1 Nút sao cho khi e Click vào nút đó thì nó hiện ra 1 cửa sổ để e chọn đến vị trí của File “*.mdb” bất kỳ với! Như vậy thì sẽ linh động hơn nhiều là để File “*.mdb” tại 1 vị trí cố định.

Đoạn Code mà máy Recoder được:
Mã:
Sheets("Frame Section Properties").Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\ThepCot.mdb;Mode" _
, _
"=Share Deny Write;ExtendedProperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _
, _
"Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions" _
, _
"=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Co" _
, _
"py Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Frame Section Properties")
.Name = "ThepCot"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\ThepCot.mdb"
.Refresh BackgroundQuery:=False
End With
Em xin chân thành cảm ơn!
 
Upvote 0
E có 1 vấn đề này mong các bác giúp:
E có 1 File Access xuất ra từ phần mềm Etabs có đuôi “*.mdb” và 1 File Excel. E muốn nhập dữ liệu từ File “*.mdb” vào các Sheets của File Excel. E dùng chức năng Recorder macro để mò Code thì e được 1 đoạn Code miêu tả quá trình nhập dữ liệu từ File “*.mdb” vào 1 Sheet của File Excel trên.
Nhưng vấn để nảy sinh là: Cái “Data Source” nó lại là cố định ứng với vị trí e để File “*.mdb” đó. Bác nào viết giúp e đoạn Code để e gán vào 1 Nút sao cho khi e Click vào nút đó thì nó hiện ra 1 cửa sổ để e chọn đến vị trí của File “*.mdb” bất kỳ với! Như vậy thì sẽ linh động hơn nhiều là để File “*.mdb” tại 1 vị trí cố định.

Đoạn Code mà máy Recoder được:
Mã:
Sheets("Frame Section Properties").Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\ThepCot.mdb;Mode" _
, _
"=Share Deny Write;ExtendedProperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _
, _
"Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions" _
, _
"=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Co" _
, _
"py Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
), Destination:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Frame Section Properties")
.Name = "ThepCot"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\ThepCot.mdb"
.Refresh BackgroundQuery:=False
End With
Em xin chân thành cảm ơn!

Bạn có thể làm như thế này.
+ Đầu tiền bạn khai báo 1 biến chuỗi, mục đích là để lưu đường dẫn.
+ Sau đó bạn gán giá trị của 01 cell nào đó trên bảng tính vào biến này, như vậy là bạn có thể thay đổi tùy ý rồi.
Mã:
Sub abc()
Dim strPath As String
strPath = Range("A1").Value
Sheets("Frame Section Properties").Select
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
    "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=strPath;Mode" _
    , _
    "=Share Deny Write;ExtendedProperties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _
    , _
    "Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions" _
    , _
    "=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Co" _
    , _
    "py Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
    ), Destination:=Range("A1"))
    .CommandType = xlCmdTable
    .CommandText = Array("Frame Section Properties")
    .Name = "ThepCot"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = strPath
    .Refresh BackgroundQuery:=False
    End With
End Sub

Trên Cell A1 của bảng tính bạn đưa đường dẫn này vào xem sao:
Mã:
C:\ThepCot.mdb
 
Upvote 0
Bạn có thể làm như thế này.
+ Đầu tiền bạn khai báo 1 biến chuỗi, mục đích là để lưu đường dẫn.
+ Sau đó bạn gán giá trị của 01 cell nào đó trên bảng tính vào biến này, như vậy là bạn có thể thay đổi tùy ý rồi.
Mình cũng vừa chạy thử nhưng Code bị báo lỗi bạn à, nhưng khi click vào nút thì ko thấy nó hiện ra cái cửa sổ để mình tự chọn đường dẫn đến file như mình đang mong muốn. Ý mình là muốn tạo ra 1 cái nút kiểu như "Nhập Dữ Liệu", khi click vào nút này thì sẽ hiện ra 1 cửa sổ để mình tự chọn đường dẫn bất kỳ đến File cần. Đường dẫn là ko cố định bạn à! File "*mdb" là file chứa dữ liệu mà mình cần import vào file Excel, và file"*mbd" đó mình muốn là nó có thể để bất kỳ ở vị trí nào trong ổ cứng, chứ nó ko để cố định ở 1 đường dẫn cụ thể nào cả. Khi mình dùng chức năng Recorder để mò Code thì mình dùng chức năng "Import External data" rồi đi đến vị trí để file "*mdb", do vậy Code ứng với Data Source là cố định với vị trí để File *mdb đó, nên thật cứng nhắc và bất tiện. Bạn xem còn cách nào ko giúp mình với, mình dốt về khoản VBA này nên mới đang tìm hiểu bước đầu coi như là ko biết gì cả!
Cảm ơn bạn nhiều!
 
Upvote 0
Mình cũng vừa chạy thử nhưng Code bị báo lỗi bạn à, nhưng khi click vào nút thì ko thấy nó hiện ra cái cửa sổ để mình tự chọn đường dẫn đến file như mình đang mong muốn. Ý mình là muốn tạo ra 1 cái nút kiểu như "Nhập Dữ Liệu", khi click vào nút này thì sẽ hiện ra 1 cửa sổ để mình tự chọn đường dẫn bất kỳ đến File cần. Đường dẫn là ko cố định bạn à! File "*mdb" là file chứa dữ liệu mà mình cần import vào file Excel, và file"*mbd" đó mình muốn là nó có thể để bất kỳ ở vị trí nào trong ổ cứng, chứ nó ko để cố định ở 1 đường dẫn cụ thể nào cả. Khi mình dùng chức năng Recorder để mò Code thì mình dùng chức năng "Import External data" rồi đi đến vị trí để file "*mdb", do vậy Code ứng với Data Source là cố định với vị trí để File *mdb đó, nên thật cứng nhắc và bất tiện. Bạn xem còn cách nào ko giúp mình với, mình dốt về khoản VBA này nên mới đang tìm hiểu bước đầu coi như là ko biết gì cả!
Cảm ơn bạn nhiều!

Vậy bạn cần tìm hiểu phương thức sau:
để bạn có thể chọn File tùy ý.
 
Upvote 0
Chào mọi người, E có 1 code của 1 tiền bối ở trong diễn đàn, ngày trước có down về xem, bỏ 1 thời gian nên quên mất bài ở đâu để hỏi tiền bối ấy. Hiện tại thì e rất cần để áp dụng vào bảng của mình nên cần hiểu rõ hết code( e là newbie). Mọi người có thể giải thích cho e code này được không ạ. Chi tiết từng dòng thì thật là tốt ạ. Cảm ơn mọi người rất nhiều!

Public Sub GPE()
Dim sArr(), dArr(), Rws As Object, Col As Object, I As Long, J As Long, K As Long
Dim Rw As Long, C As Long, iRw As Long, jCol As Long
Set Rws = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Sheets("KQ")
sArr = .Range(.[D2], .[D2].End(xlToRight)).Value
C = UBound(sArr, 2)
For J = 1 To UBound(sArr, 2)
Col.Add sArr(1, J), J
Next J
sArr = .Range(.[B3], .[B3].End(xlDown)).Value
Rw = UBound(sArr, 1)
For I = 1 To UBound(sArr, 1)
Rws.Add sArr(I, 1), I
Next I
End With
ReDim dArr(1 To Rw, 1 To C)
With Sheets("NGUON")
sArr = .Range(.[C3], .[F65536].End(xlUp)).Value
End With
For I = 1 To UBound(sArr, 1)
If Rws.Exists(sArr(I, 1)) Then
If Col.Exists(sArr(I, 4)) Then
iRw = Rws.Item(sArr(I, 1))
jCol = Col.Item(sArr(I, 4))
dArr(iRw, jCol) = dArr(iRw, jCol) + sArr(I, 3)
End If
End If
Next I
Sheets("KQ").[D3].Resize(Rw, C) = dArr
Set Rws = Nothing
Set Col = Nothing
End Sub
 

File đính kèm

  • dgđ.xls
    38.5 KB · Đọc: 8
Upvote 0
Chào mọi người, E có 1 code của 1 tiền bối ở trong diễn đàn, ngày trước có down về xem, bỏ 1 thời gian nên quên mất bài ở đâu để hỏi tiền bối ấy. Hiện tại thì e rất cần để áp dụng vào bảng của mình nên cần hiểu rõ hết code( e là newbie). Mọi người có thể giải thích cho e code này được không ạ. Chi tiết từng dòng thì thật là tốt ạ. Cảm ơn mọi người rất nhiều!

Public Sub GPE()
Dim sArr(), dArr(), Rws As Object, Col As Object, I As Long, J As Long, K As Long
Dim Rw As Long, C As Long, iRw As Long, jCol As Long
Set Rws = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
With Sheets("KQ")
sArr = .Range(.[D2], .[D2].End(xlToRight)).Value
C = UBound(sArr, 2)
For J = 1 To UBound(sArr, 2)
Col.Add sArr(1, J), J
Next J
sArr = .Range(.[B3], .[B3].End(xlDown)).Value
Rw = UBound(sArr, 1)
For I = 1 To UBound(sArr, 1)
Rws.Add sArr(I, 1), I
Next I
End With
ReDim dArr(1 To Rw, 1 To C)
With Sheets("NGUON")
sArr = .Range(.[C3], .[F65536].End(xlUp)).Value
End With
For I = 1 To UBound(sArr, 1)
If Rws.Exists(sArr(I, 1)) Then
If Col.Exists(sArr(I, 4)) Then
iRw = Rws.Item(sArr(I, 1))
jCol = Col.Item(sArr(I, 4))
dArr(iRw, jCol) = dArr(iRw, jCol) + sArr(I, 3)
End If
End If
Next I
Sheets("KQ").[D3].Resize(Rw, C) = dArr
Set Rws = Nothing
Set Col = Nothing
End Sub

- Trong này có những dòng đơn giản, bạn ghi ra đi, không biết chỗ nào mọi người bổ sung thêm, chứ làm từ A--Z hơi ngán. Một phần nữa sẽ giúp cho bạn tư duy thêm.
 
Upvote 0
- Trong này có những dòng đơn giản, bạn ghi ra đi, không biết chỗ nào mọi người bổ sung thêm, chứ làm từ A--Z hơi ngán. Một phần nữa sẽ giúp cho bạn tư duy thêm.
Cảm ơn bác phuyen89 đã góp ý ạ.
Thực ra thì e mới bâp bẹ tự hoc VBA được chừng 2 tuần, vì phần lớn là tự tra cứu trên các diễn đàn và suy diễn nên cho dù nắm được chút kiến thức nhưng vô vàn cái vẫn không biết và lơ ngơ. Code này thì e đã tự suy diễn rất nhiều với vốn kiến thức ít ỏi của mình cũng đã mường tượng được phần nào nhưng vẫn k nắm rõ được vì thiếu quá nhiều kiến thức e không biết. Nên mạn phép xin được bác giải thích chi tiết để củng cố kiến thức của mình ạ. Nếu không được thì có thể giải thích qua qua cũng được ạ. Mong không mất quá nhiều thời gian của bác và mọi người ạ. E cảm ơn!
 
Upvote 0
Code VBA
Tôi mới học VBA mong được giải thích? Tôi có 2 code sub bang1 và sub bang2 (file kèm theo), 2 sub trên theo tôi là như nhau, với sub bang1 thì báo lỗi khi tăng số dòng, với sub bang2 thì báo lỗi - có thể chỉnh dùm cách khai báo biến. giải thích tại sao?
 

File đính kèm

  • Book2.xlsb
    249.8 KB · Đọc: 12
Upvote 0
Code VBA
Tôi mới học VBA mong được giải thích? Tôi có 2 code sub bang1 và sub bang2 (file kèm theo), 2 sub trên theo tôi là như nhau, với sub bang1 thì báo lỗi khi tăng số dòng, với sub bang2 thì báo lỗi - có thể chỉnh dùm cách khai báo biến. giải thích tại sao?
PHP:
Sub bang1()
  Dim Darr(), Arr()
  Dim i As Long, j As Long, k As Long
With Sheets("1")
  Darr = Range("A1:F10000").Value
  ReDim Arr(1 To UBound(Darr), 1 To 6)
  For i = 1 To UBound(Darr)
    If Darr(i, 1) > 0 Then
      k = k + 1
      For j = 1 To 6
        Arr(k, j) = Darr(i, j)
      Next j
    End If
  Next i
Range("G1").Resize(k, 6).Value = Arr
End With
End Sub

+ Vì Darr(i,1) nó là cột, không có giá trị, vì thế biến k không bao giờ tăng lên, nó mãi mãi là số 0. Điều đó tạo nên dòng này không thể thực hiện được.
PHP:
Range("G1").Resize(k, 6).Value = Arr

-->Gây nên lỗi.
 
Upvote 0
sub bang1 vẫn chạy được mà Đại ca, k vẫn tăng theo i nhưng khi tăng dòng thì bị lỗi thôi . không hiểu vì sao- nếu viết lại code xin chỉ giáo
 
Upvote 0
Các bạn cho mình hỏi chút là mình có nhớ đọc được bài của a Hoàng Trọng Nghĩa (Không biết có phải không ạ). Khi mình sang sheet khác, thì dùng code để quay lại sheet ngay trước đó. Nay tìm mãi mà chưa thấy, nhờ các bạn tìm giúp mình. Xin cảm ơn !
 
Upvote 0
Web KT
Back
Top Bottom