Những câu hỏi về code, xin giải thích các code, đề nghị các bạn gửi vào đây (1 người xem)

  • Thread starter Thread starter ST-Lu!
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Status
Không mở trả lời sau này.

ST-Lu!

Love Wingchun
Tham gia
19/8/08
Bài viết
730
Được thích
546
Nghề nghiệp
Xích lô một thời
Kể từ hôm nay, tất cả những câu hỏi nhờ giải thích dùm một đoạn code, hay là hỏi những vấn đề linh tinh gì liên quan đến cách viết code, đề nghị các bạn gửi chung vào đây.

Những đề tài mới với tiêu đề: "Nhờ giải thích dùm đoạn code", mà không nói rõ là code gì, code dùng để làm gì, sẽ bị xóa.

BQT

----------------------------------------------------------------------------------------------------------------


Em xin được hỏi 2 đoạn code sau có tương đương nhau ?

Cells(Cells.Rows.Count, 1).End(xlUp).Row có tương đương với [A65000].End(xlup).row

Cám ơn các anh chỉ giáo
 
Chỉnh sửa lần cuối bởi điều hành viên:
Nhờ các thầy và mọi người xem dùm 2 đoạn code VBA sau
Đoạn 1:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$2" Then
Range("A35").Select
Selection.CurrentRegion.Select
Selection.ClearContents
Set DS = [A4].CurrentRegion
DS.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A35")
End If
End Sub

Đoạn 2:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$cc$10" Then
Range("BD15").Select
Selection.CurrentRegion.Select
Selection.ClearContents
Set DS = [A15].CurrentRegion
DS.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("CC9:CC10"), CopyToRange:=Range("BD15")
End If
End Sub

trong 2 file khác nhau thì:
Đoạn 1 chạy được
Đoạn 2 không chạy
nhờ mọi người sửa Code File Tu Dong Loc
 

File đính kèm

Upvote 0
Nhờ các thầy và mọi người xem dùm 2 đoạn code VBA sau
Đoạn 1:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$B$2" Then
Range("A35").Select
Selection.CurrentRegion.Select
Selection.ClearContents
Set DS = [A4].CurrentRegion
DS.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A35")
End If
End Sub

Đoạn 2:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$cc$10" Then
Range("BD15").Select
Selection.CurrentRegion.Select
Selection.ClearContents
Set DS = [A15].CurrentRegion
DS.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("CC9:CC10"), CopyToRange:=Range("BD15")
End If
End Sub

trong 2 file khác nhau thì:
Đoạn 1 chạy được
Đoạn 2 không chạy
nhờ mọi người sửa Code File Tu Dong Loc

Phải sửa lại chỗ này :
PHP:
Target.Address = "$CC$10"
mình sửa lại cho dễ nhìn :
[GPECODE=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$CC$10" Then
[BD15].CurrentRegion.ClearContents
[A15:BA1000].AdvancedFilter 2, [CC9:CC10], [BD15]
End If
End Sub
[/GPECODE]
 
Upvote 0
Phải sửa lại chỗ này :
PHP:
Target.Address = "$CC$10"
mình sửa lại cho dễ nhìn :
[GPECODE=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$CC$10" Then
[BD15].CurrentRegion.ClearContents
[A15:BA1000].AdvancedFilter 2, [CC9:CC10], [BD15]
End If
End Sub
[/GPECODE]

Như vầy mới đúng chứ chú!

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$CC$10" Then
        Range([A15], [A65536].End(3)).Resize(, 29).AdvancedFilter 2, [CC9:CC10], [COLOR=#ff0000][BD15:CE15][/COLOR]
    End If
End Sub

Với AdvancedFilter thì không cần Clear đâu nhé! Thêm vào chạy chậm code thôi hen!
 
Upvote 0
Như vầy mới đúng chứ chú!

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$CC$10" Then
        Range([A15], [A65536].End(3)).Resize(, 29).AdvancedFilter 2, [CC9:CC10], [COLOR=#ff0000][BD15:CE15][/COLOR]
    End If
End Sub

Với AdvancedFilter thì không cần Clear đâu nhé! Thêm vào chạy chậm code thôi hen!

Dạ viết như anh cũng được ,nhưng em thấy:
*với Advanced nó sẽ tìm đến vị trí cuối cùng có dữ liệu, vì thế em hay khai báo thừa ra,( không cần dùng xlUp,xlEnd..)
* Em dùng phương thức clear để phòng trường hợp giá trị dữ liệu lọc lần trước vẫn còn ( sợ lẫn lôn vào nhau !)
* Nếu là copy thì em test thấy [BD15] hay [BD15:CE15] Advanced vấn paste được toàn bộ giá trị lọc vào vùng cần copy

<-------- Hổng biết có đúng không ?
 
Upvote 0
Dạ viết như anh cũng được ,nhưng em thấy:
*với Advanced nó sẽ tìm đến vị trí cuối cùng có dữ liệu, vì thế em hay khai báo thừa ra,( không cần dùng xlUp,xlEnd..)
* Em dùng phương thức clear để phòng trường hợp giá trị dữ liệu lọc lần trước vẫn còn ( sợ lẫn lôn vào nhau !)
* Nếu là copy thì em test thấy [BD15] hay [BD15:CE15] Advanced vấn paste được toàn bộ giá trị lọc vào vùng cần copy

<-------- Hổng biết có đúng không ?

1) Nên chọn vùng chính xác, đó là tác phong chuyên nghiệp của người lập trình

2) Với Clear, bạn cứ thử lúc đầu là <=4, lúc sau, bạn chọn giá trị =1 xem sao! Dĩ nhiên, nó tự xóa các giá trị khác mà không để lại dấu vết gì. Khi tôi đã nói thêm clear là làm chậm code thì tôi đã thường xuyên thực hiện nó rồi!

3) Copy ở vùng chứa "tiêu đề cột" nào thì nó lọc đúng tiêu đề cột đó, không phải nó chọn ngẩu nhiên mà được!
 
Upvote 0
1) Nên chọn vùng chính xác, đó là tác phong chuyên nghiệp của người lập trình

2) Với Clear, bạn cứ thử lúc đầu là <=4, lúc sau, bạn chọn giá trị =1 xem sao! Dĩ nhiên, nó tự xóa các giá trị khác mà không để lại dấu vết gì. Khi tôi đã nói thêm clear là làm chậm code thì tôi đã thường xuyên thực hiện nó rồi!

3) Copy ở vùng chứa "tiêu đề cột" nào thì nó lọc đúng tiêu đề cột đó, không phải nó chọn ngẩu nhiên mà được!


^^, Cảm ơn anh nhiều !
Em xin bổ sung thêm 1 câu lệnh :
[GPECODE=vb]
ActiveSheet.AutoFilterMode = False
[/GPECODE]
 
Upvote 0
^^, Cảm ơn anh nhiều !
Em xin bổ sung thêm 1 câu lệnh :
[GPECODE=vb]
ActiveSheet.AutoFilterMode = False
[/GPECODE]

Khỏi bổ sung em trai! Dù cho nó có AutoFilter trước dữ liệu, nó vẫn lọc được như thường!

Hãy xem dữ liệu đã Filter nhé! Đồng thời, anh chỉ lấy dữ liệu vùng [BD15:BI15] tức là các tiêu đề có giá trị, mấy cái khác không thích không thêm vô.

Test nhé!
 

File đính kèm

Upvote 0
Khỏi bổ sung em trai! Dù cho nó có AutoFilter trước dữ liệu, nó vẫn lọc được như thường!

Hãy xem dữ liệu đã Filter nhé! Đồng thời, anh chỉ lấy dữ liệu vùng [BD15:BI15] tức là các tiêu đề có giá trị, mấy cái khác không thích không thêm vô.

Test nhé!

Không anh ah, ý em là nếu người dùng để chế độ filter trước thì cái xlUP sẽ không xác định đúng vùng dữ liệu : Cụ thể
nếu người dùng filter cột Code các giá trị <2 đi, thì khi nhập vào giá trị criteria =4 ===> advanced filter sẽ không đúng nữa, vì cái End(3) xác định không đúng vùng dữ liệu !
do đó em mới bổ sung cái autofiltermode = fasle
còn nếu không thì phải dùng .currentRegion anh ah <----------- Hổng biết có đúng không ?
 
Upvote 0
Không anh ah, ý em là nếu người dùng để chế độ filter trước thì cái xlUP sẽ không xác định đúng vùng dữ liệu : Cụ thể
nếu người dùng filter cột Code các giá trị <2 đi, thì khi nhập vào giá trị criteria =4 ===> advanced filter sẽ không đúng nữa, vì cái End(3) xác định không đúng vùng dữ liệu !
do đó em mới bổ sung cái autofiltermode = fasle
còn nếu không thì phải dùng .currentRegion anh ah <----------- Hổng biết có đúng không ?
OK, vấn đề này mình đồng ý! Vì liên quan đến vấn đề xác định hàng nên phải dùng đến nó!
 
Upvote 0
Cảm ơn 2 Anh đã giúp đỡ, Code của hai anh ngắn nhưng chạy vẫn đảm bảo đúng, VBA em mới thử tập Record lại và sửa lại thôi, Code ban đầu em gửi chỉ là tư duy thủ công, cái sai chính của em là không viết hoa địa chỉ ô, hóa ra trong VBA có phân biệt chữ hoa và chữ thường phải không mọi người?
 
Upvote 0
Cảm ơn 2 Anh đã giúp đỡ, Code của hai anh ngắn nhưng chạy vẫn đảm bảo đúng, VBA em mới thử tập Record lại và sửa lại thôi, Code ban đầu em gửi chỉ là tư duy thủ công, cái sai chính của em là không viết hoa địa chỉ ô, hóa ra trong VBA có phân biệt chữ hoa và chữ thường phải không mọi người?
Bạn Reccord xong mở code ra sửa địa chỉ ô thành chữ thường hết, rồi chạy code lại thử xem thế nào.
 
Upvote 0
Chỉnh lỗi code giúp mình

Em có code này mục đích là đứng sheet khác vẫn có thể chạy lệnh này, nhưng ko hiểu sao mình cho vào lệnh With Sheets / End With mà nó vẫn ko thực hiện được, phải đứng tại sheet đó nó mới cho chạy lệnh. Code này do một người bạn viết dùm em đọc thì em hiểu đại ý, nhưng còn thắc mắc ở chỗ đặt "I", nếu cao thủ nào hiểu thì viết rút gọn dùm em luôn được ko.
Chân thành cám ơn.
PHP:
Public Sub chuyendulieu()
Dim Vung As Range, I As Long
With Worksheets("MaKH")
 On Error Resume Next
    .Range([E8], [E5000].End(xlUp)).SpecialCells(2).ClearContents
    Set Vung = .Range([E8], [E5000].End(xlUp))
        For I = 1 To Vung.Rows.Count
                   If Vung(I) = "" And Vung(I).Offset(, -1) <> 0 Then Vung(I) = Vung(I).Offset(, -1)
        Next
End With
End Sub
 
Upvote 0
Em có code này mục đích là đứng sheet khác vẫn có thể chạy lệnh này, nhưng ko hiểu sao mình cho vào lệnh With Sheets / End With mà nó vẫn ko thực hiện được, phải đứng tại sheet đó nó mới cho chạy lệnh. Code này do một người bạn viết dùm em đọc thì em hiểu đại ý, nhưng còn thắc mắc ở chỗ đặt "I", nếu cao thủ nào hiểu thì viết rút gọn dùm em luôn được ko.
Chân thành cám ơn.
PHP:
Public Sub chuyendulieu()
Dim Vung As Range, I As Long
With Worksheets("MaKH")
 On Error Resume Next
    .Range([E8], [E5000].End(xlUp)).SpecialCells(2).ClearContents
    Set Vung = .Range([E8], [E5000].End(xlUp))
        For I = 1 To Vung.Rows.Count
                   If Vung(I) = "" And Vung(I).Offset(, -1) <> 0 Then Vung(I) = Vung(I).Offset(, -1)
        Next
End With
End Sub

Thiếu quá trời dấu chấm
Mã:
Public Sub chuyendulieu()
Dim Vung As Range, I As Long
With Worksheets("MaKH")
 On Error Resume Next
    [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR]Range([COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR][E8], [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR][E5000].End(xlUp)).SpecialCells(2).ClearContents
    Set Vung = [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR]Range([COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR][E8], [COLOR=#ff0000][SIZE=5].[/SIZE][/COLOR][E5000].End(xlUp))
        For I = 1 To Vung.Rows.Count
                   If Vung(I) = "" And Vung(I).Offset(, -1) <> 0 Then Vung(I) = Vung(I).Offset(, -1)
        Next
End With
End Sub
Thử thêm mấy dấu chấm màu đò như tôi làm ở trên rồi test lại xem thế nào
 
Upvote 0
Giúp lỗi VBA

Nhờ các bạn giúp mình lỗi đoạn code sau mình làm mãi không được!

Sub SL_LayDL()
Dim cnn, rst As Object
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim lsSQL As String
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\Database.accdb"
.Open

End With
lsSQL = "SELECT DataSLTH.MAGIAY, DataSLTH.SL, DataSLTH.Ghichu " & _
"FROM DataSLTH " & _
"where DataSLTH.THANG=[C5]"
rst.Open lsSQL, cnn, 1, 3 (lỗi tại đây)
[b5:g6000].ClearContents
[b5].CopyFromRecordset rst

rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing

End Sub
 
Upvote 0
Nhờ các bạn giúp mình lỗi đoạn code sau mình làm mãi không được!

Sub SL_LayDL()
Dim cnn, rst As Object
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim lsSQL As String
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\Database.accdb"
.Open

End With
lsSQL = "SELECT DataSLTH.MAGIAY, DataSLTH.SL, DataSLTH.Ghichu " & _
"FROM DataSLTH " & _
"where DataSLTH.THANG=[C5]"
rst.Open lsSQL, cnn, 1, 3 (lỗi tại đây)
[b5:g6000].ClearContents
[b5].CopyFromRecordset rst

rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing

End Sub

Thử kiểm tra như vầy xem :
Mã:
[COLOR=#000000]lsSQL = "SELECT DataSLTH.MAGIAY, DataSLTH.SL, DataSLTH.Ghichu [/COLOR][COLOR=#000000]FROM [ DataSLTH ]"[/COLOR]
[COLOR=#000000]Kiểm tra lại câu lệnh điều kiện Where xem [C5] ???[/COLOR]
rst.Open lsSQL, cnn, 3, 1,1
 
Lần chỉnh sửa cuối:
Upvote 0
Mình đã làm đúng ô điều kiện rồi!
bạn xem file đính kèm nhé!
Mình bảo đk Where bạn viết sai mà !
[GPECODE=vb]
Sub SL_LayDL()
Dim cnn, rst As Object
Set cnn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
Dim lsSQL As String
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\Database.accdb"
.Open


End With
lsSQL = "SELECT MAGIAY,SL,THANG,Ghichu " & _
"FROM DataSLTH " & _
"where THANG= " & [C3]
rst.Open lsSQL, cnn, 3, 1, 1
[A5:C6000].ClearContents
[A5].CopyFromRecordset rst

rst.Close: Set rst = Nothing
cnn.Close: Set cnn = Nothing


End Sub
[/GPECODE]
 
Upvote 0
Bạn ơi cho mình hỏi luôn có đoạn code nào vừa có thể update và thêm mới như đoạn code này không?

Sub SL_Update()
On Error GoTo loi
Set Cn = CreateObject("ADODB.Connection")
Dim MySQL As String
With Cn
MySQL = "UPDATE [DataSLTH] b " _
& "right JOIN " _
& "[Excel 8.0;HDR=Yes;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[Sanluong$A4:E6000] a " _
& "ON b.ThangID=a.ThangID " _
& "SET b.MAGIAY=a.MAGIAY,b.SL=a.SL," _
& "b.THANG=a.THANG,b.Ghichu=a.Ghichu," _
& "b.ThangID=a.ThangID " _
& "where a.ThangID is not null"
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\Database.accdb"
.CursorLocation = adUseClient
.Open
.Execute MySQL
.Close
End With
Set Cn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub

cách của mình nó sẽ rất bất tiện nếu trong data có nhiều cột thì làm cực lăm! bạn giúp mình nhé!

cảm ơn bạn!
 
Upvote 0
Bạn ơi cho mình hỏi luôn có đoạn code nào vừa có thể update và thêm mới như đoạn code này không?

Sub SL_Update()
On Error GoTo loi
Set Cn = CreateObject("ADODB.Connection")
Dim MySQL As String
With Cn
MySQL = "UPDATE [DataSLTH] b " _
& "right JOIN " _
& "[Excel 8.0;HDR=Yes;IMEX=2;DATABASE=" _
& ThisWorkbook.FullName & "].[Sanluong$A4:E6000] a " _
& "ON b.ThangID=a.ThangID " _
& "SET b.MAGIAY=a.MAGIAY,b.SL=a.SL," _
& "b.THANG=a.THANG,b.Ghichu=a.Ghichu," _
& "b.ThangID=a.ThangID " _
& "where a.ThangID is not null"
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\Database.accdb"
.CursorLocation = adUseClient
.Open
.Execute MySQL
.Close
End With
Set Cn = Nothing
Exit Sub
loi:
MsgBox Err.Description
End Sub

cách của mình nó sẽ rất bất tiện nếu trong data có nhiều cột thì làm cực lăm! bạn giúp mình nhé!

cảm ơn bạn!

Nếu mà có nhiều cột thì bạn sẽ phải dùng vòng lặp For ... Next tạo một chuỗi str thỏa mãn và gán vào câu lệnh SQL thôi
 
Upvote 0
Chào các anh chị em trong diễn đan GPE, e có file excel này muốn nhờ ac viết giúp cho e 1 code.
Ở cột C hàng thứ 9 trở đi, khi muốn gõ đúng mã hiệu như sheet DongiaTTH (ví dụ:CO.01102) thì tại các cột C,D,F,G và H sẽ lọc số liệu tương ứng từ sheet DongiaTTH với mã hiệu đã chọn và past vào các cột đã nói ở trên. Còn nếu gõ không đúng mã hiệu hoặc click phải vào cột C hàng thứ 9 thì xuất hiện một useform và trong useform sẽ xuất hiện các số liệu như sheet DongiaTTH và lúc đó ta có thể xem hoặc click các mã hiệu rồi chọn thì các số liệu đó tự động past vào sheet chi tiết. code này giống như code của phần mềm dự toán vậy. em xin cám ơn
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nhờ mọi người sửa giúp đoạn code sau.

Nhờ anh em trong diễn đàn xem thử kg biết bị sao mà nó lại báo lỗi. Tuy có chạy được theo yêu cầu định dạng như kg biết nó lại bị Debug. ||||| Nhờ anh em sửa lại giúp.
Mã:
Sub DinhDangOChu()
    Dim i, x, a, b As Integer
    Dim lastrow As Long
    lastrow = ActiveCell.End(xlDown).Row
    a = ActiveCell.Row
    b = ActiveCell.Column
    For i = 0 To lastrow - 1
    Cells(a, b).Offset(i, 5) = "=SEARCH(CHAR(10),R[0]C[-5])"
    x = ActiveCell.Offset(i, 5)
    With Cells(a, b).Offset(i, 0).Characters(Start:=1, Length:=x).Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
    End With
    With Cells(a, b).Offset(i, 0).Characters(Start:=x, Length:=999).Font
        .Name = "Arial"
        .FontStyle = "Italic"
    End With
    Next i
End Sub
 

File đính kèm

Upvote 0
Bạn sai ở đây

For i = 0 To lastrow - 1

Phải là

For i = 0 To lastrow - a


vì bạn xác định vượt vùng dữ liệu nên code bị lỗi khi chạy vào ô trống . Cũng nên On error Resume Next vào đầu Code vì nếu không có thì trong vùng có 1 ô nào đó trống cũng tèo.
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bạn rất nhiều đã giúp. Mình chạy được code trên rồi. Bạn cho mình hỏi thêm "On error Resume Next" là sao vậy bạn ? có cách nào để nó "trượt" nhanh hơn kg ?
Có cách nào để nếu mình click vào ô trống hay ô kg có kí tự Char(10) thì code kg chạy kg ? Vì khi click vào mình thấy nó chạy rất lâu và chạy hết bảng tính luôn.
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn bạn rất nhiều đã giúp. Mình chạy được code trên rồi. Bạn cho mình hỏi thêm "On error Resume Next" là sao vậy bạn ? có cách nào để nó "trượt" nhanh hơn kg ?
Có cách nào để nếu mình click vào ô trống hay ô kg có kí tự Char(10) thì code kg chạy kg ? Vì khi click vào mình thấy nó chạy rất lâu và chạy hết bảng tính luôn.
Thử chạy code này xem:
PHP:
Sub DinhDangOChu2()
Application.ScreenUpdating = False
Dim Rng As Range, Cll As Range, Tem As Long
Set Rng = Range(ActiveCell, Cells(65000, ActiveCell.Column).End(xlUp))
For Each Cll In Rng
If Cll.Value <> vbNullString Then
    Tem = InStr(1, Cll, Chr(10), 1)
    With Cll.Characters(Start:=1, Length:=Tem - 1).Font
        .Name = "Times New Roman"
        .FontStyle = "Bold"
    End With
    With Cll.Characters(Start:=Tem + 1, Length:=200).Font
        .Name = "Arial"
        .FontStyle = "Italic"
    End With
End If
Next
Set Rng = Nothing
Application.ScreenUpdating = False
End Sub
 
Upvote 0
Cảm ơn bạn Ba tê, đúng là qua mảng nó chạy nhanh hơn hẳn. Thanks bạn rất nhiều.
 
Upvote 0
Chào ACE diễn đàn GPE!
Mình cần một đoạn CODE VBA để tự động tổng hợp dữ liệu từ nhiều File excel trong cùng một Foder, yêu cầu của bài tập là:
File tổng hợp sẽ tự động tổng hợp dữ liệu của tất cả các file có trong một Foder (số lượng file trong foder này không bị giới hạn và không biết trước sẽ có bao nhiêu file) dữ liệu được tổng hợp theo từng CELL của từng Sheet tương ứng.
Mình đã tham khảo bài viết của bác @anhtuan1066 ở đây http://www.giaiphapexcel.com/forum/showthread.php?7146-Đố-vui-về-VBA!&p=253055#post253055 để viết CODE nhưng nó chỉ lấy dữ liệu được từ 1file,
Nhờ các bạn xem và chỉnh sửa CODE để có thể thực hiện bài tập ah. Vui lòng xem file đính kèm.
Để CODE thực thi trên file (tất cả các Sheet của file tổng hợp đều được tổng hợp dữ liệu) thì phải chỉnh sửa ntn ah?
 

File đính kèm

Upvote 0
nhờ mấy a giải thik dùm e cái code này.code này viết để điều khiển mạch quang báo led ma trận dùng AT 89s52.code này là code asm.

Đây là diễn đàn Excel mà bạn
Ở đây chuyên về VBA và Visual Basic, bạn hỏi cái gì đâu có phải là "lộn tiệm" không?
 
Upvote 0
Upvote 0
ĐÂY LÀ MỘT ĐOẠN CODE MÌNH THAM KHẢO TỪ FILE TRÊN DIỄN ĐÀN VÀ THAY ĐỔI CHÚT THÔI
Là một đoạn code để mình nhập hồ sơ khách mua hàng, có 3 cột nhập là Tên - Địa chỉ - Thông tin
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then
MsgBox "Your information is insufficient", , "ATTENTION !"
Exit Sub
End If
'find first empty row in database
iRow = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row
'copy the data to the database
ws.Cells(iRow, 2).Value = Me.TextBox1.Value
ws.Cells(iRow, 4).Value = Me.TextBox2.Value
ws.Cells(iRow, 6).Value = Me.TextBox3.Value
'clear the data
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
Me.TextBox1.SetFocus
End Sub

Thật ra mình chẳng biết tẹo gì về VBA, nhìn rồi đoán thôi, cái (IRow,4)..(IRow,2) thì hiểu đó là cột tương ứng từ A,B,C....
Nhưng ''CÁI SỐ 2'' kia thì mình cứ thay đổi linh tinh cả. Không biết xác định thế nào để thông tin nhập vào
rơi đúng dòng đầu tiên sau tiêu đề mình cần.
Các bạn giúp với!. hix
 
Upvote 0
Mình có bài toán yêu cầu như thế này. Cột A nhập dữ liệu thì cột B hàng tương ứng hiển thị thời gian nhập dữ liệu của cột A. Giả sử ô A2 nhập dữ liệu thì ô B2 hiển thị thời gian nhập cô A2, sau đó ô B2 tự động khóa lại không cho người dùng tác động điều chỉnh. Khi ô A2 được nhập dữ liệu mới thì ô B2 tự động mở ra và hiển thị thời gian nhập số liệu tương ứng rồi lại khóa lại.
Mình mới có code cho hiển thị thời gian, chưa có code cho trạng thái khóa và mở khóa cho Ô B2 như trên, các bác có cao kiến gì giúp đỡ em vs.
code của em như sau:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
If Intersect(Target, [A1:A10]) Is Nothing Then Exit Sub
For Each Cll In Intersect(Target, [A1:A10])
If Cll <> "" Then
If Cll <> Cll.ID Then
Cll.Offset(, 1) = Format(Now, "hh:mm AM/PM")
Cll.ID = Cll
End If
Else
Cll.Offset(, 1).ClearContents
Cll.ID = ""
End If
Next
End Sub
 
Upvote 0
Đây là diễn đàn Excel mà bạn
Ở đây chuyên về VBA và Visual Basic, bạn hỏi cái gì đâu có phải là "lộn tiệm" không?

Nhờ các anh chị giải thích code của hàm sau với:

Private Declare Function GetMeID Lib "excelqt.dll" (ByVal RT As String) As Integer
Declare Function GetActiveWindow Lib "user32" () As Long

Function ThongtinKTXD(ByVal ODIA As String, SOHDDSR As Integer) As String
Dim Serial As String
Dim ret As Integer
Serial = Space$(256)
ret = GetMeID(Serial)
If SOHDDSR = 13971 Then
ThongtinKTXD = Serial
ThongtinKTXD = Trim(ThongtinKTXD)
Else
ThongtinKTXD = ""
End If
End Function

Function NumberWindow() As Long
Dim NumberWND As Long
NumberWindow = GetActiveWindow()
End Function
 
Upvote 0
Hỏi lại bạn hàm này
Mã:
Private Declare Function GetMeID Lib "excelqt.dll" (ByVal RT As String) As Integer

Ở đâu ra vậy?
 
Upvote 0
Em copy trong 1 modul và em ko biết nó làm việc như thế nào, anh giúp em với được ko?

Tôi đoán đến 99% rằng hàm này do ai đó tạo ra từ VB6 và đóng gói thành DLL (file excelqt.dll) để dùng trên Excel
Vậy nếu chưa cài đặt chương trình để có file excelqt.dll thì làm sao mà test đây?
Mà nè, tự nhiên copy module của người ta về test chơi vậy sao? Ít ra bạn cũng phải biết code ấy dùng vào việc gì chứ?
 
Upvote 0
cho em hỏi với, nếu khi cài đặt thì file này nó nằm trong system phải không anh? em đang tìm hiểu cách làm HWID như 1 đề tài em có hỏi trên diễn đàn. Nếu đúng vậy thì em có tìm được trên google 1 bộ form tạo HWID từ VB6. có gì anh chỉ giúp em với nha. Thanks anh ndu96081631 nhiều
 
Upvote 0
Chỉ giúp cho sai dòng code VBA ( lính mới)

Public Function tong(sobachu As Long)
Dim a As Long, b As Long, c As Long
c = sobachu Mod 10
b = sobachu Mod 100 - c
a = (sobachu - b * 10 - c) / 100
tong = a + b + c
End Function

Đề bài là: Viết hàm nhận 1 số nguyên dương có 3 chữ số, tính tổng của 3 chữ số đó. Mình đã viết nhủ trên nhưng chạy thử với số 456 sai.( kết quả đúng 15 lại ra 56). Thank!
 
Upvote 0
Bạn thử với hàm này & sau đó đối chiếu:

Mã:
[B]Function Tong3So(ABC As Long)
[/B] Tong3So = ABC \ 100 + (ABC \ 10 Mod 10) + (ABC Mod 10)
[B]End Function[/B]
 
Upvote 0
Chào bạn mình la thành viên mới. Thấy bảo chưa post được 30 bài thì chưa lập topic gi đó được. đọc trên diễn đàn thấy bảo posts nhờ trên topic khác: cho minh hỏi vói nhé minh moi hoc VBA: Đề bài là: Viết hàm nhận 1 số nguyên dương có 3 chữ số, tính tổng của 3 chữ số đó. mình đã viết đoạn code thử làm bên dưới nhưng khi chạy lại sai. Giả sử số đó là 456 thì kết quả phải la 15 nhưng khi chạy lại ra 56. mong ban chỉ giup!
Public Function tong(sobachu As Long)
Dim a As Long, b As Long, c As Long
c = sobachu Mod 10
b = sobachu Mod 100 - c
a = (sobachu - b * 10 - c) / 100
tong = a + b + c
End Function

Bạn sai cái b.
Ví dụ có 456 thì
c = 6 => b = sobachu Mod 100 - c = 456 mod 100 - 6 = 56 - 6 = 50

Chắc bạn biết sửa?
 
Upvote 0
Cảm ơn ban trước, mình đã thử đoạn code của ban với số có 3 chữ số la 456 Kq là 15 đã đúng. Nhưng cho hỏi thêm là đoạn code của minh logic sai chỗ nào với????
 
Lần chỉnh sửa cuối:
Upvote 0
Mình vừa thử trên cửa sổ Immediate đây mà:

Này nha:

?Tong3So(456) = Tong3So(654)
True!
 
Upvote 0
Nhờ bổ sung thêm CODE để có thể tổng hợp cho tất cả các SHEET

Mình có đoạn CODE này để tổng hợp dữ liệu, nhưng nó chỉ tổng hợp được dữ liệu của một SHEET có tên là "MAU1". Nhờ các cao thủ chỉnh sửa giúp để CODE có thể tổng hợp cho tất cả các SHEET từ dữ liệu tương ứng của các file:

Option Explicit
Sub BCTK(Folder As String, ShName As String, SrcRng As String, Target As Range)
Dim Temp As String
Temp = ShName & "'!" & Range(SrcRng).Address(, , 2)
If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
ActiveWorkbook.Names.Add "Arr", "=""'" & Folder & "[""&Files(""" & Folder & "*.*"")&""]" & Temp & """"
Target.Consolidate Evaluate("Arr"), 9, 0, 1
ActiveWorkbook.Names("Arr").Delete
End Sub
Sub Tonghop()
Dim Folder As String, ShName As String, SrcRng As String
Range("B12:M27").ClearContents
With CreateObject("Shell.Application")
On Error Resume Next
Folder = .BrowseForFolder(0, "", 1).Self.Path
End With
ShName = "MAU1": SrcRng = "B12:M27"
BCTK Folder, ShName, SrcRng, Range("B12")
End Sub

Xin cảm ơn!
 
Upvote 0
Giải thích giup tu khoá

Từ khoá mình muốn hỏi là " Ran.Rows.Count và Ran.Columns.Count "
Trong ví du:
Public Function Tong(Ran As Range)
Dim d As Integer, c As Integer, sum As Double
sum = 0
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
sum = sum + Ran.Cells(d, c)
Next c
Next d
Tong = sum
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Từ khoá mình muốn hỏi là " Ran.Rows.Count và Ran.Columns.Count "
Trong ví du:
Public Function Tong(Ran As Range)
Dim d As Integer, c As Integer, sum As Double
sum = 0
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
sum = sum + Ran.Cells(d, c)
Next c
Next d
Tong = sum
End Function
Ran.Rows.Count là đếm số HÀNG vùng có tên là Ran
Ran.Columns.Count là đếm số CỘT vùng có tên là Ran
 
Upvote 0
Cảm ơn ban nhé. Mới bít một ít nên khổ thế đấy. Cái gì cũng la mới lạ!
 
Upvote 0
Thớt này dài quá rồi, tôi đóng tại đây.
 
Upvote 0
Giúp mình tìm lỗi cho đoạn CODE này với......

Ko hiểu sao trong sheet HoaDon mình chọn lựa nhập phần Tỉnh - Tên Khách Hàng - Mã KH xong rồi nhấn Nhập Hoá Đơn trên sheet Hoa Don lại báo lỗi . trong khí không nhập phần Tỉnh - Tên KH - Mã KH thì lại ko báo lỗi.
Các pro giúp mình với
Thanks
 

File đính kèm

Upvote 0
Lỗi là do bạn dùng lẫn lộn 2 phương thức AddItem và Rowsource. Vì còn liên quan đến lọc nên bạn phải giữ lại phương thức AddItem và vào Properties của cbbMa và cbbName xóa Rowsource của nó đi là OK
 
Upvote 0
Có cách nào khác để làm phần combobox trong phần Tỉnh - Khách Hàng - Mã Khách hàng mà không cần dùng Name như mình làm không bạn
 
Upvote 0
Đây là Form mà vai trò của 2 Combo này hoàn toàn khác xa với mục đích nhập liệu. Chính vì vậy mà việc sử dụng nó để nhập liệu là không hợp lý và dẫm chân lên nhau. Banj nên bổ xung 1 Form khác hoặc dùng 1 Combo thôi để làm việc này.
 
Upvote 0
Status
Không mở trả lời sau này.

Bài viết mới nhất

Back
Top Bottom