thanhnam0119
Thành viên hoạt động



- Tham gia
- 5/10/07
- Bài viết
- 152
- Được thích
- 4
Chào các a chị! Nhờ các a chị giúp đỡ
em có file sheet "tổng hợp" và sheet "bieu_01bd" giờ em muốn in từ trang đến trang theo các hộ gia đình(mỗi hộ gia đình 1 trang). Xin các a chị giúp đỡ lệnh thể hiện hoàng loạt với tiêu chí mỗi hộ 1 trang in (theo mẫu ở sheet "bieu_01BD". E xin cảm ơn nhiều.
Option Explicit
Sub intheoho1()
Dim arr, arr1, dic As Object, lr As Long, i As Long, T, T1, a, s As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("tong hop")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 3 Then Exit Sub
arr = .Range("B3:L" & lr).Value
End With
For i = 1 To UBound(arr, 1)
If Not dic.exists(arr(i, 1)) Then
dic.Add arr(i, 1), i
Else
dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) & "#" & i
End If
Next i
For Each T In dic.keys
a = 0: ReDim arr1(1 To UBound(arr, 1), 1 To 10)
s = dic.Item(T)
For Each T1 In Split(s, "#")
a = a + 1
arr1(a, 1) = a
arr1(a, 2) = arr(T1, 3)
arr1(a, 3) = arr(T1, 2)
arr1(a, 4) = arr(T1, 4)
arr1(a, 5) = arr(T1, 5)
arr1(a, 6) = arr(T1, 8)
arr1(a, 7) = arr(T1, 9)
arr1(a, 8) = arr(T1, 7)
arr1(a, 9) = arr(T1, 1)
arr1(a, 10) = arr(T1, 11)
Next
With Sheets("Bieu 01_BD")
.Range("A14:j24").ClearContents
.Rows("14:24").EntireRow.Hidden = False
.Range("A14").Resize(a, 10) = arr1
.Rows(a + 14 & ":24").EntireRow.Hidden = True
.PrintPreview
End With
Next
End Sub
em có file sheet "tổng hợp" và sheet "bieu_01bd" giờ em muốn in từ trang đến trang theo các hộ gia đình(mỗi hộ gia đình 1 trang). Xin các a chị giúp đỡ lệnh thể hiện hoàng loạt với tiêu chí mỗi hộ 1 trang in (theo mẫu ở sheet "bieu_01BD". E xin cảm ơn nhiều.
Option Explicit
Sub intheoho1()
Dim arr, arr1, dic As Object, lr As Long, i As Long, T, T1, a, s As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("tong hop")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr < 3 Then Exit Sub
arr = .Range("B3:L" & lr).Value
End With
For i = 1 To UBound(arr, 1)
If Not dic.exists(arr(i, 1)) Then
dic.Add arr(i, 1), i
Else
dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) & "#" & i
End If
Next i
For Each T In dic.keys
a = 0: ReDim arr1(1 To UBound(arr, 1), 1 To 10)
s = dic.Item(T)
For Each T1 In Split(s, "#")
a = a + 1
arr1(a, 1) = a
arr1(a, 2) = arr(T1, 3)
arr1(a, 3) = arr(T1, 2)
arr1(a, 4) = arr(T1, 4)
arr1(a, 5) = arr(T1, 5)
arr1(a, 6) = arr(T1, 8)
arr1(a, 7) = arr(T1, 9)
arr1(a, 8) = arr(T1, 7)
arr1(a, 9) = arr(T1, 1)
arr1(a, 10) = arr(T1, 11)
Next
With Sheets("Bieu 01_BD")
.Range("A14:j24").ClearContents
.Rows("14:24").EntireRow.Hidden = False
.Range("A14").Resize(a, 10) = arr1
.Rows(a + 14 & ":24").EntireRow.Hidden = True
.PrintPreview
End With
Next
End Sub
File đính kèm
Lần chỉnh sửa cuối: