Chuyên mục xử lý, gỡ rối code VBA (2 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Status
Không mở trả lời sau này.
ndu96081631

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,957
Sắp xếp theo thời gian sắp xếp theo bầu chọn
If join(application.transpose(application.transpose("a1:bz1")),",") <> "brcd,custseq,custnm,apprseq,apprdt,apprmatdt,ccy,appramt,dsbsseq,dsbsdt,dsbsmatdt,sprd,sprdpst,dsbsamt,dsbsccy,rpmtamt,intamt,dsbsbal,dsbsamt2,rpmtamt2,intamt2,subunit,custstscd,custtpcd,custtpnm,custdtltpcd,custdtltpnm,ecomist,ecomistnm,taxtpcdloc,taxtpcdlocnm,ofcno,ofcnm,pstintamt,pstintamt2,buscd,lntpcd,lnsbtpcd,lstrpmtdt,lstintchrgprd,nxtrpmtschddt,nxtintschddt,exmtintamt,exmtintamt2,finainsttpcd,finainsttpcdnm,sicdloc,province,provincenm,district,districtnm,zipcd,addr1,secured,fndrstpcd,fndrsnm,exemptint,exemptinttype,fndprpstpcd,fndprpstpcd_code,intrpmtamt,AQCCDFIN,intrpmtamt2,commcd,commmn,grpno,trctcd,trctnm,BSNSSCLTPCD,usrid,usrnm,acramt,lceqa,yrdays,intcmth,intrpymth,inttrmmth,remark" Then
...
 
Upvote 0
Các cao thủ gỡ giúp em vụ này với:
Chả là em muốn làm cái module tổng hợp máy thi công từ nhiều hạng mục công trình với yêu cầu:
- Tổng hợp máy theo mã hiệu máy
- Khối lượng và Giá tiền tính theo pp cộng dồn
- Đơn giá tính theo pp bình quân gia quyền (Tổng giá trị/Tổng khối lượng)

Em code thế này mà nó không cho kq đúng:

Public Sub TongHopMayTC()
Dim Ws As Worksheet, srcDAT, dstDAT(1 To 65000, 1 To 8), r, i As Long


With CreateObject("scripting.dictionary")
For Each Ws In Worksheets
If Ws.Name <> "tonghop.M" Then
srcDAT = Ws.Range("A5", Ws.Range("J65000").End(xlUp))


For r = 1 To UBound(srcDAT)
If Not IsEmpty(srcDAT(r, 2)) Then
If Not .exists(srcDAT(r, 2)) Then
i = i + 1
.Add srcDAT(r, 2), i
dstDAT(i, 1) = i
dstDAT(i, 2) = srcDAT(r, 2)
dstDAT(i, 3) = srcDAT(r, 3)
dstDAT(i, 4) = srcDAT(r, 4)
dstDAT(i, 5) = srcDAT(r, 5)
dstDAT(i, 6) = ":v"
dstDAT(i, 7) = srcDAT(r, 7)
dstDAT(i, 8) = srcDAT(r, 8)
Else
dstDAT(.Item(srcDAT(r, 2)), 5) = dstDAT(.Item(srcDAT(r, 2)), 5) + srcDAT(r, 5) ' Cong don khoi luong
dstDAT(.Item(srcDAT(r, 2)), 8) = dstDAT(.Item(srcDAT(r, 2)), 8) + srcDAT(r, 8) ' Cong don thanh tien
If dstDAT(.Item(srcDAT(r, 2)), 5) <> 0 Then dstDAT(.Item(srcDAT(r, 2)), 7) = dstDAT(.Item(srcDAT(r, 2)), 8) / dstDAT(.Item(srcDAT(r, 2)), 5) 'Tinh don gia theo PP binh quan
End If
End If
Next r


End If
Next Ws
End With


With Sheets("tonghop.M")
.UsedRange.Clear
.Range("A1").Resize(i, 8) = dstDAT
.UsedRange.Font.Name = ".vntime"
.UsedRange.Borders.LineStyle = 1
.UsedRange.Columns.AutoFit
End With

End Sub


Cảm ơn các bác,
 

File đính kèm

Upvote 0
vippmuhm đã viết:
Các cao thủ gỡ giúp em vụ này với:
Chả là em muốn làm cái module tổng hợp máy thi công từ nhiều hạng mục công trình với yêu cầu:
- Tổng hợp máy theo mã hiệu máy
- Khối lượng và Giá tiền tính theo pp cộng dồn
- Đơn giá tính theo pp bình quân gia quyền (Tổng giá trị/Tổng khối lượng)

Em code thế này mà nó không cho kq đúng:

Public Sub TongHopMayTC()
Dim Ws As Worksheet, srcDAT, dstDAT(1 To 65000, 1 To 8), r, i As Long


With CreateObject("scripting.dictionary")
For Each Ws In Worksheets
If Ws.Name <> "tonghop.M" Then
srcDAT = Ws.Range("A5", Ws.Range("J65000").End(xlUp))


For r = 1 To UBound(srcDAT)
If Not IsEmpty(srcDAT(r, 2)) Then
If Not .exists(srcDAT(r, 2)) Then
i = i + 1
.Add srcDAT(r, 2), i
dstDAT(i, 1) = i
dstDAT(i, 2) = srcDAT(r, 2)
dstDAT(i, 3) = srcDAT(r, 3)
dstDAT(i, 4) = srcDAT(r, 4)
dstDAT(i, 5) = srcDAT(r, 5)
dstDAT(i, 6) = ":v"
dstDAT(i, 7) = srcDAT(r, 7)
dstDAT(i, 8) = srcDAT(r, 8)
Else
dstDAT(.Item(srcDAT(r, 2)), 5) = dstDAT(.Item(srcDAT(r, 2)), 5) + srcDAT(r, 5) ' Cong don khoi luong
dstDAT(.Item(srcDAT(r, 2)), 8) = dstDAT(.Item(srcDAT(r, 2)), 8) + srcDAT(r, 8) ' Cong don thanh tien
If dstDAT(.Item(srcDAT(r, 2)), 5) <> 0 Then dstDAT(.Item(srcDAT(r, 2)), 7) = dstDAT(.Item(srcDAT(r, 2)), 8) / dstDAT(.Item(srcDAT(r, 2)), 5) 'Tinh don gia theo PP binh quan
End If
End If
Next r


End If
Next Ws
End With


With Sheets("tonghop.M")
.UsedRange.Clear
.Range("A1").Resize(i, 8) = dstDAT
.UsedRange.Font.Name = ".vntime"
.UsedRange.Borders.LineStyle = 1
.UsedRange.Columns.AutoFit
End With

End Sub


Cảm ơn các bác,
Nhấp chuột vào đây để mở rộng...
Sửa lại theo code của bạn nhé: (Kiểm tra coi có sai chỗ nào không)
Mã: 
Public Sub TongHopMayTC()
Dim Ws As Worksheet, DL, kq(1 To 65000, 1 To 8), r, i As Long
   With CreateObject("scripting.dictionary")
     For Each Ws In Worksheets
       If Ws.Name <> "tonghop.M" Then
          DL = Ws.Range(Ws.[A5], Ws.[H65000].End(xlUp)).Value
            For r = 1 To UBound(DL)
              If DL(r, 2) <> Empty Then
                If Not .exists(DL(r, 2)) Then
                 i = i + 1
                .Add DL(r, 2), i
                kq(i, 1) = i
                kq(i, 2) = DL(r, 2)
                kq(i, 3) = DL(r, 3)
                kq(i, 4) = DL(r, 4)
                kq(i, 5) = DL(r, 5)
                kq(i, 6) = ":v"
                kq(i, 7) = DL(r, 7)
                kq(i, 8) = DL(r, 8)
               Else
                kq(.Item(DL(r, 2)), 5) = kq(.Item(DL(r, 2)), 5) + DL(r, 5)
                kq(.Item(DL(r, 2)), 8) = kq(.Item(DL(r, 2)), 8) + DL(r, 8)
                If kq(.Item(DL(r, 2)), 5) <> 0 Then kq(.Item(DL(r, 2)), 7) _
                  = kq(.Item(DL(r, 2)), 8) / kq(.Item(DL(r, 2)), 5)
               End If
             End If
          Next r
      End If
    Next Ws
  End With
With Sheets("tonghop.M")
    .UsedRange.Clear
    .[A2].Resize(i, 8) = kq
    .UsedRange.Font.Name = ".vntime"
    .UsedRange.Borders.LineStyle = 1
    .UsedRange.Columns.AutoFit
End With
End Sub
 
Upvote 0
giangleloi đã viết:
Sửa lại theo code của bạn nhé: (Kiểm tra coi có sai chỗ nào không)
Mã: 
Public Sub TongHopMayTC()
Dim Ws As Worksheet, DL, kq(1 To 65000, 1 To 8), r, i As Long
   With CreateObject("scripting.dictionary")
     For Each Ws In Worksheets
       If Ws.Name <> "tonghop.M" Then
          DL = Ws.Range(Ws.[A5], Ws.[H65000].End(xlUp)).Value
            For r = 1 To UBound(DL)
              If DL(r, 2) <> Empty Then
                If Not .exists(DL(r, 2)) Then
                 i = i + 1
                .Add DL(r, 2), i
                kq(i, 1) = i
                kq(i, 2) = DL(r, 2)
                kq(i, 3) = DL(r, 3)
                kq(i, 4) = DL(r, 4)
                kq(i, 5) = DL(r, 5)
                kq(i, 6) = ":v"
                kq(i, 7) = DL(r, 7)
                kq(i, 8) = DL(r, 8)
               Else
                kq(.Item(DL(r, 2)), 5) = kq(.Item(DL(r, 2)), 5) + DL(r, 5)
                kq(.Item(DL(r, 2)), 8) = kq(.Item(DL(r, 2)), 8) + DL(r, 8)
                If kq(.Item(DL(r, 2)), 5) <> 0 Then kq(.Item(DL(r, 2)), 7) _
                  = kq(.Item(DL(r, 2)), 8) / kq(.Item(DL(r, 2)), 5)
               End If
             End If
          Next r
      End If
    Next Ws
  End With
With Sheets("tonghop.M")
    .UsedRange.Clear
    .[A2].Resize(i, 8) = kq
    .UsedRange.Font.Name = ".vntime"
    .UsedRange.Borders.LineStyle = 1
    .UsedRange.Columns.AutoFit
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Nét rồi bác, số liệu đẹp mỹ mãn luôn!
Cảm ơn bác nhé!
 
Upvote 0
giangleloi đã viết:
Sửa lại theo code của bạn nhé: (Kiểm tra coi có sai chỗ nào không)
Mã: 
Public Sub TongHopMayTC()
Dim Ws As Worksheet, DL, kq(1 To 65000, 1 To 8), r, i As Long
   With CreateObject("scripting.dictionary")
     For Each Ws In Worksheets
       If Ws.Name <> "tonghop.M" Then
          DL = Ws.Range(Ws.[A5], Ws.[H65000].End(xlUp)).Value
            For r = 1 To UBound(DL)
              If DL(r, 2) <> Empty Then
                If Not .exists(DL(r, 2)) Then
                 i = i + 1
                .Add DL(r, 2), i
                kq(i, 1) = i
                kq(i, 2) = DL(r, 2)
                kq(i, 3) = DL(r, 3)
                kq(i, 4) = DL(r, 4)
                kq(i, 5) = DL(r, 5)
                kq(i, 6) = ":v"
                kq(i, 7) = DL(r, 7)
                kq(i, 8) = DL(r, 8)
               Else
                kq(.Item(DL(r, 2)), 5) = kq(.Item(DL(r, 2)), 5) + DL(r, 5)
                kq(.Item(DL(r, 2)), 8) = kq(.Item(DL(r, 2)), 8) + DL(r, 8)
                If kq(.Item(DL(r, 2)), 5) <> 0 Then kq(.Item(DL(r, 2)), 7) _
                  = kq(.Item(DL(r, 2)), 8) / kq(.Item(DL(r, 2)), 5)
               End If
             End If
          Next r
      End If
    Next Ws
  End With
With Sheets("tonghop.M")
    .UsedRange.Clear
    .[A2].Resize(i, 8) = kq
    .UsedRange.Font.Name = ".vntime"
    .UsedRange.Borders.LineStyle = 1
    .UsedRange.Columns.AutoFit
End With
End Sub
Nhấp chuột vào đây để mở rộng...
em thấy khác ở 2 chỗ:
Mã: 
[COLOR=#000000] DL = Ws.Range(Ws.[A5], Ws.[H65000].End(xlUp)).[/COLOR][B][COLOR=#ff0000]Value[/COLOR]' -- [/B]
Và chỗ này, kiểm tra key trống, tồn tại:
Mã: 
 If DL(r, 2) <> Empty Then                If Not .exists(DL(r, 2)) Then
Nói chung, là em chưa bằng chủ thớt, em nhìn thấy cũng là tiếp xúc nhiều mà thôi.
Em test rồi, mởi chủ thớt test
 
Upvote 0
babe_nice đã viết:
em thấy khác ở 2 chỗ:
Mã: 
[COLOR=#000000] DL = Ws.Range(Ws.[A5], Ws.[H65000].End(xlUp)).[/COLOR][B][COLOR=#ff0000]Value[/COLOR]' -- [/B]
Và chỗ này, kiểm tra key trống, tồn tại:
Mã: 
 If DL(r, 2) <> Empty Then                If Not .exists(DL(r, 2)) Then
Nói chung, là em chưa bằng chủ thớt, em nhìn thấy cũng là tiếp xúc nhiều mà thôi.
Em test rồi, mởi chủ thớt test
Nhấp chuột vào đây để mở rộng...
Cái đó tôi chỉ viết lại theo cách của tôi thôi, vấn đề là nằm ở chỗ này:
Mã: 
[COLOR=#000000] DL = Ws.Range([/COLOR][COLOR=#ff0000]Ws.[A5], Ws.[H65000][/COLOR][COLOR=#000000].End(xlUp)).[/COLOR]Value
 
Upvote 0
hpkhuong đã viết:
Các bạn đang giao lưu vấn đề chi đây.??? Bạn có chắc cái bạn phát hiện là điều làm code chạy đúng...???
Nhấp chuột vào đây để mở rộng...
chắc người ta đang hỏi (r,2) nếu có dữ liệu thì chạy ...nếu không thì khỏi key mằm chi cho mất công đó mà...--=0
 
Upvote 0
hpkhuong đã viết:
Các bạn đang giao lưu vấn đề chi đây.??? Bạn có chắc cái bạn phát hiện là điều làm code chạy đúng...???
Nhấp chuột vào đây để mở rộng...
Không, không,....anh hpkhuong có hiểu nhầm ý em không ạ?
Em chỉ nói kiến thức em chỉ nhận thấy như thế, còn như anh giangleloi đã bổ sung mấu chốt rồi ạ.
Em cũng nói ngay là em không bằng chủ thớt, tức là không viết được như thế. Nếu viết được như thế thì em sẽ chú ý mấy điểm em nói...và đương nhiên code chạy vẫn sai.
Ý em không phải để nói đúng sai hay chạy hay không ạ? em xin hết, không tham gia ý gì nữa....
 
Upvote 0
Em đã chỉnh sửa theo code mà các ACE cho nhưng giờ nó báo lỗi out

Sub msit80_kiemtra()
Dim r As Long, arr, dArr
arr = Array("brcd", "custseq", "custnm", "apprseq", "apprdt", "apprmatdt", _
"ccy", "appramt", "dsbsseq", "dsbsdt", "dsbsmatdt", "sprd", "sprdpst", "dsbsamt", _
"dsbsccy", "rpmtamt", "intamt", "dsbsbal", "dsbsamt2", "rpmtamt2", "intamt2", "subunit", _
"custstscd", "custtpcd", "custtpnm", "custdtltpcd", "custdtltpnm", "ecomist", "ecomistnm", _
"taxtpcdloc", "taxtpcdlocnm", "ofcno", "ofcnm", "pstintamt", "pstintamt2", "buscd", "lntpcd", _
"lnsbtpcd", "lstrpmtdt", "lstintchrgprd", "nxtrpmtschddt", "nxtintschddt", "exmtintamt", "exmtintamt2", _
"finainsttpcd", "finainsttpcdnm", "sicdloc", "province", "provincenm", "district", "districtnm", "zipcd", _
"addr1", "secured", "fndrstpcd", "fndrsnm", "exemptint", "exemptinttype", "fndprpstpcd", "fndprpstpcd_code", _
"intrpmtamt", "AQCCDFIN", "intrpmtamt2", "commcd", "commmn", "grpno", "trctcd", "trctnm", "BSNSSCLTPCD", "usrid", _
"usrnm", "acramt", "lceqa", "yrdays", "intcmth", "intrpymth", "inttrmmth", "remark", "chitiet_htls")

Dim tenWsVBA, tenWs As String
tenWsVBA = ActiveSheet.CodeName
tenWs = ActiveSheet.Name
dArr = Worksheets(tenWsVBA).Range("A1:CA1").value

For r = 1 To UBound(dArr, 2) Step 1
If dArr(1, r) <> arr(r - 1) Then Exit For
Next
If r <= UBound(dArr, 2) Then MsgBox "error at cell " & Cells(1, r).Address Else MsgBox "Good"
End Sub
Khi chạy đến hôm nay lại bị phát sinh lỗi sau: [TABLE="width: 100%"]
[TR]
[TD="align: left"][/TD]
[/TR]
[TR]
[TD="align: left"]Subscript out of range (Error 9) và em vào debug thì ko biết chỉnh ntn ah? Mong mọi người chỉ giúp?[/TD]
[/TR]
[/TABLE]
 
Upvote 0
Lequocvan đã viết:
Sub msit80_kiemtra()
Dim r As Long, arr, dArr
arr = Array("brcd", "custseq", "custnm", "apprseq", "apprdt", "apprmatdt", _
"ccy", "appramt", "dsbsseq", "dsbsdt", "dsbsmatdt", "sprd", "sprdpst", "dsbsamt", _
"dsbsccy", "rpmtamt", "intamt", "dsbsbal", "dsbsamt2", "rpmtamt2", "intamt2", "subunit", _
"custstscd", "custtpcd", "custtpnm", "custdtltpcd", "custdtltpnm", "ecomist", "ecomistnm", _
"taxtpcdloc", "taxtpcdlocnm", "ofcno", "ofcnm", "pstintamt", "pstintamt2", "buscd", "lntpcd", _
"lnsbtpcd", "lstrpmtdt", "lstintchrgprd", "nxtrpmtschddt", "nxtintschddt", "exmtintamt", "exmtintamt2", _
"finainsttpcd", "finainsttpcdnm", "sicdloc", "province", "provincenm", "district", "districtnm", "zipcd", _
"addr1", "secured", "fndrstpcd", "fndrsnm", "exemptint", "exemptinttype", "fndprpstpcd", "fndprpstpcd_code", _
"intrpmtamt", "AQCCDFIN", "intrpmtamt2", "commcd", "commmn", "grpno", "trctcd", "trctnm", "BSNSSCLTPCD", "usrid", _
"usrnm", "acramt", "lceqa", "yrdays", "intcmth", "intrpymth", "inttrmmth", "remark", "chitiet_htls")

Dim tenWsVBA, tenWs As String
tenWsVBA = ActiveSheet.CodeName
tenWs = ActiveSheet.Name
dArr = Worksheets(tenWsVBA).Range("A1:CA1").value

For r = 1 To UBound(dArr, 2) Step 1
If dArr(1, r) <> arr(r - 1) Then Exit For
Next
If r <= UBound(dArr, 2) Then MsgBox "error at cell " & Cells(1, r).Address Else MsgBox "Good"
End Sub
Khi chạy đến hôm nay lại bị phát sinh lỗi sau: [TABLE="width: 100%"]
[TR]
[TD="align: left"][/TD]
[/TR]
[TR]
[TD="align: left"]Subscript out of range (Error 9) và em vào debug thì ko biết chỉnh ntn ah? Mong mọi người chỉ giúp?[/TD]
[/TR]
[/TABLE]
Nhấp chuột vào đây để mở rộng...
Tôi nghĩ mảng "arr" so với mảng "dArr" thiếu một hoặc vài phần tử tương ứng.
 
Upvote 0
Mình có file đính kèm tạo lịch calendar khi kích chọn 1 ô trong sheet thì hiện lên lịch để chọn ngày tháng năm, thì được rồi, nhưng mình muốn tạo 2 hoặc ba cột nữa, vi dụ: trong file gửi kèm là cột B4:B30, nhưng mình muốn tạo thêm cột K4:K30, M4:M30 thì chỉnh code lại như thế nào mong các bạn chỉ dùm mình, mình không phải dân VBA nên chi tiết càng tốt các bạn nhé, thank nhiều!-=.,,
 

File đính kèm

Upvote 0
nguyenhuutinh25 đã viết:
Mình có file đính kèm tạo lịch calendar khi kích chọn 1 ô trong sheet thì hiện lên lịch để chọn ngày tháng năm, thì được rồi, nhưng mình muốn tạo 2 hoặc ba cột nữa, vi dụ: trong file gửi kèm là cột B4:B30, nhưng mình muốn tạo thêm cột K4:K30, M4:M30 thì chỉnh code lại như thế nào mong các bạn chỉ dùm mình, mình không phải dân VBA nên chi tiết càng tốt các bạn nhé, thank nhiều!-=.,,
Nhấp chuột vào đây để mở rộng...
Bạn sửa chỗ này (thêm chỗ màu đỏ)
Mã: 
If Intersect(Target, [COLOR=#ff0000]Union([/COLOR][B4:B30][COLOR=#ff0000], [k4:k30])[/COLOR]) Is Nothing Or Target.Count > 1 Then
 
Upvote 0
Cho em hỏi đoạn code này của thầy ndu

Option Explicit
Function Filter2DArray(ByVal SourceArray, ByVal ColIndex As Long, ByVal SearchText As String, ByVal HasTitle As Boolean)
Dim aTmp, arr, dic, aKey
Dim lR As Long, lC As Long, dTmpVal As Double
Dim bChk As Boolean
On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary")
aTmp = SourceArray
ColIndex = ColIndex + LBound(aTmp, 2) - 1
bChk = (InStr("><=", Left(SearchText, 1)) > 0)
For lR = LBound(aTmp, 1) - HasTitle To UBound(aTmp, 1)
If bChk And SearchText <> "" Then
dTmpVal = CDbl(aTmp(lR, ColIndex))
If Evaluate(dTmpVal & SearchText) Then dic.Add lR, ""
Else
If Left(SearchText, 1) = "!" Then
If Not (UCase(aTmp(lR, ColIndex)) Like UCase(Mid(SearchText, 2, Len(SearchText)))) Then dic.Add lR, ""
Else
If UCase(aTmp(lR, ColIndex)) Like UCase(SearchText) Then dic.Add lR, ""
End If
End If
Next
If dic.Count > 0 Then
aKey = dic.Keys
ReDim arr(LBound(aTmp, 1) To UBound(aKey) + LBound(aTmp, 1) - HasTitle, LBound(aTmp, 2) To UBound(aTmp, 2))
For lR = LBound(aTmp, 1) - HasTitle To UBound(aKey) + LBound(aTmp, 1) - HasTitle
For lC = LBound(aTmp, 2) To UBound(aTmp, 2)
arr(lR, lC) = aTmp(aKey(lR - LBound(aTmp, 1) + HasTitle), lC)
Next
Next
If HasTitle Then
For lC = LBound(aTmp, 2) To UBound(aTmp, 2)
arr(LBound(aTmp, 1), lC) = aTmp(LBound(aTmp, 1), lC)
Next
End If
End If
Filter2DArray = arr
End Function
Function SheetExists(ByVal SheetName As String) As Boolean
On Error Resume Next
SheetExists = Not Worksheets(SheetName) Is Nothing
End Function
Sub Main()
Dim aSrc, aRes
Dim wks As Worksheet, wksSrc As Worksheet, dic As Object
Dim SheetName As String
Dim lR As Long, lCount As Long
Set wksSrc = Worksheets("Sheet1")
aSrc = wksSrc.Range("A1:d10000")
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
Application.ScreenUpdating = False
For lR = 2 To UBound(aSrc, 1)
SheetName = CStr(aSrc(lR, 3))
If Len(SheetName) Then
If Not dic.Exists(SheetName) Then
dic.Add SheetName, lR
If Not SheetExists(SheetName) Then
lCount = lCount + 1
With Worksheets.Add(After:=Worksheets(lCount))
.Name = SheetName
.Tab.Color = vbRed
End With
Else
Worksheets(SheetName).Tab.Color = False
End If
Set wks = Worksheets(SheetName)
aRes = Filter2DArray(aSrc, 3, SheetName, True)
wks.UsedRange.ClearContents
wks.Range("A1").Resize(UBound(aRes, 1), 3).Value = aRes
End If
End If
Next
wksSrc.Select
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Code dùng để tách sheet theo dữ liệu ở cột C. File của thầy có 3 cột. Vậy cho em hỏi áp dụng cho file có nhiều hơn 3 cột thì em cần thay đổi mã lệnh nào ạ? Và nếu dữ liệu tách của em không nằm ở cột C mà ở cột bất kỳ thì em thay đổi chỗ nào?? Mong mọi người giải đáp giúp em!
 
Upvote 0
À em hiểu rồi mấu chốt là ở đoạn aSrc = wksSrc.Range("A1:C10000")

Cho em hỏi nếu như ở sheet dữ liệu em có tiêu để ví dụ như
Danh sách lớp…
Niên khóa
Thì làm thế nào để lặp lại tiêu để đó ở các sheet được tách ra?
Nói cách khác định dạng sẽ được giữ nguyên như file mẹ.
 
Lần chỉnh sửa cuối:
Upvote 0
Gửi các anh em trong diễn đàn!
Do ở topic, bác Trung Chinh đã lâu không onl nên xin mạn phép nhờ các cao nhân giúp đỡ sửa lệnh của file mẫu (đính kèm)
Link topic: http://www.giaiphapexcel.com/forum/showthread.php?81851-Soạn-thảo-văn-bản-Word-từ-Excel

Mình có chút ý kiến về File Excel_19-6-2015.xls
1. Khi gõ 1 số ở sheet Data (C5: 80000) Nếu kích đúp chuột thì sẽ bị nhảy số 80,000 đồng
Để vậy cũng tiện nhưng nếu lỡ tay kích đúp thì rất khó sửa.
Bỏ giúp mình việc kick đúp chuột khỏi bị đổi giá trị được không?
(Mình mò thì tại ShData (Data) có xóa đoạn:
With Selection(2, 1)
If .Value = 0 Then
.Value = "=docso(" & Selection & ")"
.Value = .Value
End If
End With
Selection = "=fixed(" & Selection & ",0)"
Selection = Selection.Value & " " & ChrW(273) & ChrW(7891) & "ng"
thì thấy nó không nhảy thêm "đồng" nữa - không biết có đúng không? Xóa có bị sang cái khác không?)

2. Khi để số sheet Data (C5: 80000) thì khi chạy file (Ctrl + Shift + W) ra file Ngay 30.12.doc , các số đều không có dấu phân cách các hàng (VD: 80,000)
Mình đang cần khi chạy file thì ra kết quả có dấu phân cách các hàng của số. Giúp mình với.

Cám ơn các anh em rất nhiều!
 

File đính kèm

Upvote 0
Giải thích và chỉnh sửa giúp mình file chứa macro, mình mở file báo lỗi "Missing end Braket". Cám ơn bạn nhiều!
 

File đính kèm

Upvote 0
maint1311 đã viết:
Giải thích và chỉnh sửa giúp mình file chứa macro, mình mở file báo lỗi "Missing end Braket". Cám ơn bạn nhiều!
Nhấp chuột vào đây để mở rộng...
Code này được viết khi máy có cài đặt hệ ngôn ngữ Asia, nếu tôi không nhầm thì đó là tiếng Nhật.

Bây giờ bạn mang code đó sang máy không có hệ ngôn ngữ Asia thì sẽ báo lỗi.

Cách khắc phục: bạn cài đặt hệ ngôn ngữ Asia cho máy (Tiếng Nhật).
 
Upvote 0
Cám ơn bạn nhiều, mình đã làm theo hướng dẫn của bạn nhưng vẫn không được.
 
Upvote 0
maint1311 đã viết:
Cám ơn bạn nhiều, mình đã làm theo hướng dẫn của bạn nhưng vẫn không được.
Nhấp chuột vào đây để mở rộng...
Mình quên chưa nói với bạn là Office bạn sử dụng cũng phải là bản Nhật ngữ.

Trường hợp này mình đã gặp khá nhiều.

Code người Nhật viết hầu hết trên office, window tiếng Nhật của họ. Khi chuyển sang Việt Nam thì ngôn ngữ bị đảo lộn rất nhiều.

Bạn có thể Test trên 1 bản office tiếng Nhật để so sánh nhé.
 
Upvote 0
A ơi nếu như e mún tìm 1 content trong 1 file excel có nhiều sheet và content đó có cấu trúc giống nhau VD: SPOT P18-44|HA NOI

Và content nằm ở ô A1 của các sheet trong file NGUON
Chỉ khác nhau phần in đậm nghiêng thui thì dùng VBA bằng cách nào vậy a

E cám ơn a
 
Lần chỉnh sửa cuối:
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
Trả lời
0
Đọc
23
TramAnhNguyen692
T
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU
Trả lời
11
Đọc
111
Duy Tùng 9x
Duy Tùng 9x
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng,
Trả lời
8
Đọc
42
thuytrangbp28
T
V
Help: Hàm đếm lọc giá trị trùng (3 người xem)
Trả lời
11
Đọc
52
Duy Tùng 9x
Duy Tùng 9x
B
XIN HƯỚNG DẪN CÁCH ĐỂ HÀM XLOOKUP TỰ NHẢY THEO SỐ LƯỢNG DÒNG CỦA ĐIỀU KIỆN KHÔNG SỬ DỤNG VBA
Trả lời
2
Đọc
29
Duy Tùng 9x
Duy Tùng 9x
C
Filter có điều kiện đang ở dạng Cột
Trả lời
2
Đọc
43
thuytrangbp28
T
L
Có ai biết fix lỗi này không ạ
    • Buồn
Trả lời
2
Đọc
35
lekimhuy0812
L
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
5
Đọc
167
Gà Công Nghệ
Gà Công Nghệ
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại (1 người xem)
Trả lời
0
Đọc
30
Kecodonlalala
K
N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình
    • Cảm ơn
    • Thích
Trả lời
7
Đọc
152
newbiexo
N
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
3
Đọc
64
Nguyễn Duy Tuân
Nguyễn Duy Tuân
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application (1 người xem)
    • Thích
Trả lời
2
Đọc
141
Nguyễn Duy Tuân
Nguyễn Duy Tuân
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
7
Đọc
328
PhanTuHuong
PhanTuHuong
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
    • Yêu thích
Trả lời
1
Đọc
69
PhanTuHuong
PhanTuHuong
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
8
Đọc
189
thuytrangbp28
T
K
Làm sao để ô excel hiển thị tên nhưng khi nhấp vào thì đó là công thức
Trả lời
1
Đọc
47
pycckuu410
P
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
41
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
326
Đọc
25K
pycckuu410
P
V
  • Question Question
Đếm xếp loại của đơn hàng
Trả lời
8
Đọc
233
vanlinh_2904
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom