Sổ chi tiết 131,331 bằng VBA (1 người xem)

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

comet_1701

Thành viên tiêu biểu
Tham gia
24/5/14
Bài viết
632
Được thích
459
Mã:
Sub Sochitiet()
Dim Cll As Range, vung As Range, i As Long
Set vung = Sheet1.Range("F1:F" & Sheet1.Range("F65000").End(xlUp).Row)
i = 13
i = i + 1
Shee4.Range("A14:J24,I13:J13,I25:J25").ClearContents
  Sheet4.Range("A14:J24").EntireRow.Hidden = False
For Each Cll In vung
If Cll = Sheet4.Range("F5") Then
Sheet4.Range("A", i) = Cll.Offset(0, -5)
Sheet4.Range("B", i) = Cll.Offset(0, -4)
Sheet4.Range("C", i) = Cll.Offset(0, -3)
Sheet4.Range("D", i) = Cll.Offset(0, -2)
Sheet4.Range("E", i) = Cll.Offset(0, -1)
Sheet4.Range("G", i) = Cll.Offset(0, 2)
Sheet4.Range("H", i) = Cll.Offset(0, 3)
Sheet4.Range("I", i) = Cll.Offset(0, 4)
Sheet4.Range("I", i) = Cll.Offset(0, 5)
End If
Next
End Sub
Em dùng đoạn code như trên để thực hiện sổ chi tiết 131,331 nhưng làm chưa được
Nhờ anh chị sửa lại giúp em với ah
Em cảm ơn
 

File đính kèm

Bạn sửa
Mã:
i=13
i=i+1
Shee4.range...
thành
Mã:
i=14
Sheet4.Range...
sửa Sheet4.Range("A",i) thành Sheet4.Range("A" & i), tương tự với B, C,..., I.
 
Upvote 0
Bạn sửa
Mã:
i=13
i=i+1
Shee4.range...
thành
Mã:
i=14
Sheet4.Range...
sửa Sheet4.Range("A",i) thành Sheet4.Range("A" & i), tương tự với B, C,..., I.
Mã:
Sub Sochitiet()
Dim Cll As Range, vung As Range, i As Long
Set vung = Sheet1.Range("F1:F" & Sheet1.Range("F65000").End(xlUp).Row)
i = 13
i = i + 1
[COLOR=#b22222]Shee4.Range("A14:J24,I13:J13,I25:J25").ClearContents[/COLOR]
  Sheet4.Range("A14:J24").EntireRow.Hidden = False
For Each Cll In vung
If Cll = Sheet4.Range("F5") Then
Sheet4.Range("A" & i) = Cll.Offset(0, -5)
Sheet4.Range("B" & i) = Cll.Offset(0, -4)
Sheet4.Range("C" & i) = Cll.Offset(0, -3)
Sheet4.Range("D" & i) = Cll.Offset(0, -2)
Sheet4.Range("E" & i) = Cll.Offset(0, -1)
Sheet4.Range("G" & i) = Cll.Offset(0, 2)
Sheet4.Range("H" & i) = Cll.Offset(0, 3)
Sheet4.Range("I" & i) = Cll.Offset(0, 4)
Sheet4.Range("J" & i) = Cll.Offset(0, 5)
End If
Next
End Sub
Sửa như anh gợi ý vẫn chưa được anh ah,
Nó báo lỗi vùng màu đỏ
 
Upvote 0
Vâng, em sơ suất quá
nhưng mã OH chỉ ra được một dòng anh ah, trong khi OH xuất hiện 2 lần anh ah
Mã:
Sub Sochitiet()
Dim Cll As Range, vung As Range, i As Long
Set vung = Sheet1.Range("F1:F" & Sheet1.Range("F65000").End(xlUp).Row)
i = 14
Sheet4.Range("A14:J24,I13:J13,I25:J25").ClearContents
Sheet4.Range("A14:J24").EntireRow.Hidden = False
For Each Cll In vung
If Cll = Sheet4.Range("F5") Then
Sheet4.Range("A" & i) = Cll.Offset(0, -5)
Sheet4.Range("B" & i) = Cll.Offset(0, -4)
Sheet4.Range("C" & i) = Cll.Offset(0, -3)
Sheet4.Range("D" & i) = Cll.Offset(0, -2)
Sheet4.Range("E" & i) = Cll.Offset(0, -1)
Sheet4.Range("G" & i) = Cll.Offset(0, 2)
Sheet4.Range("H" & i) = Cll.Offset(0, 3)
Sheet4.Range("I" & i) = Cll.Offset(0, 4)
Sheet4.Range("I" & i) = Cll.Offset(0, 5)
i = i + 1
End If
Next
End Sub
Dòng i=i+1 cần đưa vào vòng lặp For.
 
Upvote 0
Mã:
Sub Sochitiet()
Dim Cll As Range, vung As Range, i As Long
Set vung = Sheet1.Range("F1:F" & Sheet1.Range("F65000").End(xlUp).Row)
i = 14
Sheet4.Range("A14:J24,I13:J13,I25:J25").ClearContents
Sheet4.Range("A14:J24").EntireRow.Hidden = False
For Each Cll In vung
If Cll = Sheet4.Range("F5") Then
Sheet4.Range("A" & i) = Cll.Offset(0, -5)
Sheet4.Range("B" & i) = Cll.Offset(0, -4)
Sheet4.Range("C" & i) = Cll.Offset(0, -3)
Sheet4.Range("D" & i) = Cll.Offset(0, -2)
Sheet4.Range("E" & i) = Cll.Offset(0, -1)
Sheet4.Range("G" & i) = Cll.Offset(0, 2)
Sheet4.Range("H" & i) = Cll.Offset(0, 3)
Sheet4.Range("I" & i) = Cll.Offset(0, 4)
Sheet4.Range("I" & i) = Cll.Offset(0, 5)
i = i + 1
End If
Next
End Sub
Dòng i=i+1 cần đưa vào vòng lặp For.
Em cũng đoán sai ở đó nhưng chưa biết cách đưa vào
chuẩn men là phải đưa vào vòng lặp để thực hiện
Em học mót vba thôi ah
Em cảm ơn anh nhé
Em test đã ok
Em băn khoăn một chút là làm cách nào xóa or ẩn dòng trắng thừa đi
Em thấy trên diễn đàn nhiều anh chị hay viết vậy
 
Lần chỉnh sửa cuối:
Upvote 0
Em cũng đoán sai ở đó nhưng chưa biết cách đưa vào
chuẩn men là phải đưa vào vòng lặp để thực hiện
Em học mót vba thôi ah
Em cảm ơn anh nhé
Em test đã ok
Em băn khoăn một chút là làm cách nào xóa or ẩn dòng trắng thừa đi
Em thấy trên diễn đàn nhiều anh chị hay viết vậy
Mình cũng học mót vba như bạn thôi.
Bạn thêm dòng sau vào dòng gần cuối, trước lệnh End Sub
Mã:
Sheet4.Range("a" & i, "j24").EntireRow.Hidden = True
 
Upvote 0
Mình cũng học mót vba như bạn thôi.
Bạn thêm dòng sau vào dòng gần cuối, trước lệnh End Sub
Mã:
Sheet4.Range("a" & i, "j24").EntireRow.Hidden = True
Phải thêm i vào nó mới hiểu
lúc đầu em thêm
Sheet4.Range("A14:J24).EntireRow.Hidden = True nó ko nhận
Ok roài ah
Thank anh
 
Upvote 0
Mã:
Sub So()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value
End With
Sheet4.Range("A14:J24,I25:J25").ClearContents
Sheet4.Range("A14:J24").EntireRow.Hidden = False
For i = 1 To UBound(Rng)
k = 14
k = k + 1
If Rng(i, 6) = Sheet4.Range("F5") Then
Rng(i, 1) = KQ(k, 1)
Rng(i, 2) = KQ(k, 2)
Rng(i, 3) = KQ(k, 3)
Rng(i, 4) = KQ(k, 4)
Rng(i, 5) = KQ(k, 5)
Rng(i, 8) = KQ(k, 7)
Rng(i, 9) = KQ(k, 8)
Rng(i, 10) = KQ(k, 9)
Rng(i, 11) = KQ(k, 10)
End If
If k > 13 Then
Sheet4.Range("I25").Value = WorksheetFunction.Sum(Sheet4.Range("I14:I" & k))
Sheet4.Range("J25").Value = WorksheetFunction.Sum(Sheet4.Range("J14:J" & k))
End If
Next
Sheet4.Range("a" & k, "j24").EntireRow.Hidden = True
End Sub
cũng với bài này em thử dùng mảng nhưng chưa được, nhờ anh chị kiểm tra giúp em nhé
Với số liệu nhiều mà ko dùng mảng thì chạy lâu quá ah
em cảm ơn
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Mã:
Sub So()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value
End With
Sheet4.Range("A14:J24,I25:J25").ClearContents
Sheet4.Range("A14:J24").EntireRow.Hidden = False
For i = 1 To UBound(Rng)
k = 14
k = k + 1
If Rng(i, 6) = Sheet4.Range("F5") Then
Rng(i, 1) = KQ(k, 1)
Rng(i, 2) = KQ(k, 2)
Rng(i, 3) = KQ(k, 3)
Rng(i, 4) = KQ(k, 4)
Rng(i, 5) = KQ(k, 5)
Rng(i, 8) = KQ(k, 7)
Rng(i, 9) = KQ(k, 8)
Rng(i, 10) = KQ(k, 9)
Rng(i, 11) = KQ(k, 10)
End If
If k > 13 Then
Sheet4.Range("I25").Value = WorksheetFunction.Sum(Sheet4.Range("I14:I" & k))
Sheet4.Range("J25").Value = WorksheetFunction.Sum(Sheet4.Range("J14:J" & k))
End If
Next
Sheet4.Range("a" & k, "j24").EntireRow.Hidden = True
End Sub
cũng với bài này em thử dùng mảng nhưng chưa được, nhờ anh chị kiểm tra giúp em nhé
Với số liệu nhiều mà ko dùng mảng thì chạy lâu quá ah
em cảm ơn

Sửa lại thành code này

[GPECODE=vb]
Sub So()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value2
End With
With Sheets("331")
.Range("A14:J24,I25:J25").ClearContents
.Range("A14:J24").EntireRow.Hidden = False
k = 0
For i = 1 To UBound(Rng)
If Rng(i, 6) = .Range("F5").Value2 Then
k = k + 1
KQ(k, 1) = Rng(i, 1)
KQ(k, 2) = Rng(i, 2)
KQ(k, 3) = Rng(i, 3)
KQ(k, 4) = Rng(i, 4)
KQ(k, 5) = Rng(i, 5)
KQ(k, 7) = Rng(i, 8)
KQ(k, 8) = Rng(i, 9)
KQ(k, 9) = Rng(i, 10)
KQ(k, 10) = Rng(i, 11)
End If


Next
If k Then
.Range("A14").Resize(k, 10).Value = KQ
.Range("I25").Value = WorksheetFunction.Sum(.Range("I14:I" & k + 14))
.Range("J25").Value = WorksheetFunction.Sum(.Range("J14:J" & k + 14))
.Range("a" & k + 14, "j24").EntireRow.Hidden = True
End If
End With
End Sub
[/GPECODE]
 
Upvote 0
Sửa lại thành code này

[GPECODE=vb]
Sub So()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value2
End With
With Sheets("331")
.Range("A14:J24,I25:J25").ClearContents
.Range("A14:J24").EntireRow.Hidden = False
k = 0
For i = 1 To UBound(Rng)
If Rng(i, 6) = .Range("F5").Value2 Then
k = k + 1
KQ(k, 1) = Rng(i, 1)
KQ(k, 2) = Rng(i, 2)
KQ(k, 3) = Rng(i, 3)
KQ(k, 4) = Rng(i, 4)
KQ(k, 5) = Rng(i, 5)
KQ(k, 7) = Rng(i, 8)
KQ(k, 8) = Rng(i, 9)
KQ(k, 9) = Rng(i, 10)
KQ(k, 10) = Rng(i, 11)
End If


Next
If k Then
.Range("A14").Resize(k, 10).Value = KQ
.Range("I25").Value = WorksheetFunction.Sum(.Range("I14:I" & k + 14))
.Range("J25").Value = WorksheetFunction.Sum(.Range("J14:J" & k + 14))
.Range("a" & k + 14, "j24").EntireRow.Hidden = True
End If
End With
End Sub
[/GPECODE]

Đã đúng yêu cầu. Em đã test thành công
Em cảm ơn bác nhé
 
Upvote 0
Vẫn đề tài này, giờ em muốn tạo một command button In so chi tiet, khi kích vào nút này t oàn bộ sổ chi tiết 131,331 sẽ được in
Nhờ anh chị giúp đỡ nhé
Mã:
[COLOR=#000000][COLOR=#0000BB]Sub intrangbangdiemchuan_Click[/COLOR][COLOR=#007700]()
    [/COLOR][COLOR=#0000BB]On Error Resume Next
    ActiveWindow[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]SelectedSheets[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]PrintOut copies:=1
End Sub  [/COLOR][/COLOR]
Phải chăng tạo thêm một đoạn code Insocai y hệt đoạn code (So) ở trên và thêm đoạn code màu xanh vào ah
Mã:
Sub So()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value
End With
With Sheets("331")
    .Range("A14:J24,I25:J25").ClearContents
    .Range("A14:J24").EntireRow.Hidden = False
k = 0
For i = 1 To UBound(Rng)
    If Rng(i, 6) = .Range("F5").Value2 Then
        k = k + 1
        KQ(k, 1) = Rng(i, 1)
        KQ(k, 2) = Rng(i, 2)
        KQ(k, 3) = Rng(i, 3)
        KQ(k, 4) = Rng(i, 4)
        KQ(k, 5) = Rng(i, 5)
        KQ(k, 7) = Rng(i, 8)
        KQ(k, 8) = Rng(i, 9)
        KQ(k, 9) = Rng(i, 10)
        KQ(k, 10) = Rng(i, 11)
    End If
 
 
Next
If k Then
    .Range("A14").Resize(k, 10).Value = KQ
    .Range("I25").Value = WorksheetFunction.Sum(.Range("I14:I" & k + 14))
    .Range("J25").Value = WorksheetFunction.Sum(.Range("J14:J" & k + 14))
    .Range("a" & k + 14, "j24").EntireRow.Hidden = True
End If
End With
End Sub

Sub In_sochitiet()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value
End With
With Sheets("331")
    .Range("A14:J24,I25:J25").ClearContents
    .Range("A14:J24").EntireRow.Hidden = False
k = 0
For i = 1 To UBound(Rng)
    If Rng(i, 6) = .Range("F5").Value2 Then
        k = k + 1
        KQ(k, 1) = Rng(i, 1)
        KQ(k, 2) = Rng(i, 2)
        KQ(k, 3) = Rng(i, 3)
        KQ(k, 4) = Rng(i, 4)
        KQ(k, 5) = Rng(i, 5)
        KQ(k, 7) = Rng(i, 8)
        KQ(k, 8) = Rng(i, 9)
        KQ(k, 9) = Rng(i, 10)
        KQ(k, 10) = Rng(i, 11)
    End If
 
 
Next
If k Then
    .Range("A14").Resize(k, 10).Value = KQ
    .Range("I25").Value = WorksheetFunction.Sum(.Range("I14:I" & k + 14))
    .Range("J25").Value = WorksheetFunction.Sum(.Range("J14:J" & k + 14))
    .Range("a" & k + 14, "j24").EntireRow.Hidden = True
End If
 If WorksheetFunction.Sum(.Range("I25:J26")) > 0 Then ActiveWindow.SelectedSheets.PrintOut Copies:=1
End With
End Sub
Sau khi sửa như vậy, hiện tại em chỉ in được duy nhất 1 khách là OH, còn mã AM không in được ah
 
Lần chỉnh sửa cuối:
Upvote 0
Vẫn đề tài này, giờ em muốn tạo một command button In so chi tiet, khi kích vào nút này t oàn bộ sổ chi tiết 131,331 sẽ được in
Nhờ anh chị giúp đỡ nhé
Sau khi sửa như vậy, hiện tại em chỉ in được duy nhất 1 khách là OH, còn mã AM không in được ah

Tốt nhất nên tạo nút lệnh in riêng biết đâu mình không muốn in thử code này xem sau thay đổi vùng thích hợp. Nên set máy in mặc định là pdf để kiểm tra coi code chạy đúng không vì in ra máy in trực tiếp tốn giấy ráng chịu --=0


[GPECODE=vb]
Sub PrintSo()
With Sheets("331").PageSetup
.PrintArea = .Parent.Range("A1:J33").Address
.FitToPagesWide = 1
.FitToPagesTall = 100
.Parent.PrintOut 1
End With
End Sub


[/GPECODE]
 
Upvote 0
Tốt nhất nên tạo nút lệnh in riêng biết đâu mình không muốn in thử code này xem sau thay đổi vùng thích hợp. Nên set máy in mặc định là pdf để kiểm tra coi code chạy đúng không vì in ra máy in trực tiếp tốn giấy ráng chịu --=0


[GPECODE=vb]
Sub PrintSo()
With Sheets("331").PageSetup
.PrintArea = .Parent.Range("A1:J33").Address
.FitToPagesWide = 1
.FitToPagesTall = 100
.Parent.PrintOut 1
End With
End Sub


[/GPECODE]
Như anh nói là em nên cài máy in ảo PDF cute or Do đúng ko anh
Code vừa rồi em in chỉ ra một mã OH
có thể làm cách nào in được tất cả mã khách trong một lần in ko anh
 
Upvote 0
Như anh nói là em nên cài máy in ảo PDF cute or Do đúng ko anh
Code vừa rồi em in chỉ ra một mã OH
có thể làm cách nào in được tất cả mã khách trong một lần in ko anh
Đúng rồi bạn
Vậy thử code này, có gì bạn thay đổi vùng mã khách hàng cho thích hợp

[GPECODE=vb]
Sub So()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
Dim clls As Range
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value2
End With
With Sheets("331")
For Each clls In .Range("M6:M7") ' Thay dổi vùng này
.[F5].Value = clls.Value
.Range("A14:J24,I25:J25").ClearContents
.Range("A14:J24").EntireRow.Hidden = False
k = 0
For i = 1 To UBound(Rng)
If Rng(i, 6) = .Range("F5").Value2 Then
k = k + 1
KQ(k, 1) = Rng(i, 1)
KQ(k, 2) = Rng(i, 2)
KQ(k, 3) = Rng(i, 3)
KQ(k, 4) = Rng(i, 4)
KQ(k, 5) = Rng(i, 5)
KQ(k, 7) = Rng(i, 8)
KQ(k, 8) = Rng(i, 9)
KQ(k, 9) = Rng(i, 10)
KQ(k, 10) = Rng(i, 11)
End If
Next
If k Then
.Range("A14").Resize(k, 10).Value = KQ
.Range("I25").Value = WorksheetFunction.Sum(.Range("I14:I" & k + 14))
.Range("J25").Value = WorksheetFunction.Sum(.Range("J14:J" & k + 14))
.Range("a" & k + 14, "j24").EntireRow.Hidden = True
With .PageSetup
.PrintArea = .Parent.Range("A1:J33").Address ' thay đổi vùng này thích hợp
.FitToPagesWide = 1
.FitToPagesTall = 100
.Parent.PrintOut 1
End With
End If


Next
End With
End Sub


[/GPECODE]
 
Upvote 0
Đúng rồi bạn
Vậy thử code này, có gì bạn thay đổi vùng mã khách hàng cho thích hợp

[GPECODE=vb]
Sub So()
Dim Rng(), i As Long, KQ(1 To 10000, 1 To 10), k As Long
Dim clls As Range
With Sheets("nkc")
Rng = .Range(.[A11], .[A65000].End(3)).Resize(, 11).Value2
End With
With Sheets("331")
For Each clls In .Range("M6:M7") ' Thay dổi vùng này
.[F5].Value = clls.Value
.Range("A14:J24,I25:J25").ClearContents
.Range("A14:J24").EntireRow.Hidden = False
k = 0
For i = 1 To UBound(Rng)
If Rng(i, 6) = .Range("F5").Value2 Then
k = k + 1
KQ(k, 1) = Rng(i, 1)
KQ(k, 2) = Rng(i, 2)
KQ(k, 3) = Rng(i, 3)
KQ(k, 4) = Rng(i, 4)
KQ(k, 5) = Rng(i, 5)
KQ(k, 7) = Rng(i, 8)
KQ(k, 8) = Rng(i, 9)
KQ(k, 9) = Rng(i, 10)
KQ(k, 10) = Rng(i, 11)
End If
Next
If k Then
.Range("A14").Resize(k, 10).Value = KQ
.Range("I25").Value = WorksheetFunction.Sum(.Range("I14:I" & k + 14))
.Range("J25").Value = WorksheetFunction.Sum(.Range("J14:J" & k + 14))
.Range("a" & k + 14, "j24").EntireRow.Hidden = True
With .PageSetup
.PrintArea = .Parent.Range("A1:J33").Address ' thay đổi vùng này thích hợp
.FitToPagesWide = 1
.FitToPagesTall = 100
.Parent.PrintOut 1
End With
End If


Next
End With
End Sub


[/GPECODE]
Anh thêm for each vào M6:M7 thì thua anh rồi
Vùng cần thay đổi, em sẽ biết thay đổi phù hợp ah
Cảm ơn anh và anh Hậu rất nhiều

 
Upvote 0
Anh thêm for each vào M6:M7 thì thua anh rồi
Vùng cần thay đổi, em sẽ biết thay đổi phù hợp ah
Cảm ơn anh và anh Hậu rất nhiều

Vậy đúng ý bạn không?. Nhưng mình nghĩ nút Print nên để riêng khi có nhu cầu in vì chưa chắc muốn in toàn bộ lỡ chạy ra bậy tốn giấy là sếp la chết |||||
 
Upvote 0
Vậy đúng ý bạn không?. Nhưng mình nghĩ nút Print nên để riêng khi có nhu cầu in vì chưa chắc muốn in toàn bộ lỡ chạy ra bậy tốn giấy là sếp la chết |||||

ah, vâng, em cảm ơn anh, em sẽ để print riêng
Tất nhiên là đúng ý em roài ah,
Em test cả vào file thật rồi anh ah
Chạy ầm ầm--=0
 
Upvote 0
Như anh nói là em nên cài máy in ảo PDF cute or Do đúng ko anh
Code vừa rồi em in chỉ ra một mã OH
có thể làm cách nào in được tất cả mã khách trong một lần in ko anh
- Bạn cần sửa dòng
Mã:
If Rng(i,6)=.Range("F5").Value2 Then
thành
Mã:
If Rng(i, 6) <> "" Then
- Dòng
Mã:
 Activewindow.Selectedsheet.Printout copies:=1
có thể sửa thành
Mã:
.Printout  Preview:=True
để xem trước kết quả, đỡ phải in ra máy ảo, Copies nếu không đưa vào thì mặc định là 1.
 
Lần chỉnh sửa cuối:
Upvote 0

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

Back
Top Bottom