Nhờ giúp tạo macro in theo list hồ sơ, có quy định sheet in theo mỗi số thứ tự (1 người xem)

  • Thread starter Thread starter diennv50
  • Ngày gửi Ngày gửi
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)
D

diennv50

Thành viên mới
Tham gia
27/8/09
Bài viết
22
Được thích
0
Mình muốn tạo macro in list hồ sơ theo thứ tự từ a đến b, kèm theo điều kiện để chọn sheet in theo yêu cầu.
 

File đính kèm

diennv50 đã viết:
Mình muốn tạo macro in list hồ sơ theo thứ tự từ a đến b, kèm theo điều kiện để chọn sheet in theo yêu cầu.
Nhấp chuột vào đây để mở rộng...
Bạn tham khảo thử
Mã: 
Sub InBB()
    Dim Rng As Range, Cll As Range, SoBB As String
With Sheet1
    Set Rng = .Range("A11", .Range("A" & Rows.Count).End(xlUp))
End With
With Sheet2
    For Each Cll In Rng
        If Cll.Value <> Empty And IsNumeric(Cll.Value) Then
            .Range("N55").Value = Cll.Value
            .PrintPreview
            SoBB = .Range("A53").Value
            If InStrRev(SoBB, "VC", -1, vbBinaryCompare) > 0 Then
                Sheet3.PrintPreview: Sheet4.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "ATGT", -1, vbBinaryCompare) > 0 Then
                Sheet5.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "BT", -1, vbBinaryCompare) > 0 Then
                Sheet4.PrintPreview
            End If
        End If
Tiep:
    Next
End With
End Sub
Khi nào ưng cái bụng thì thay PrintPreview bằng PrintOut nhoé
 
PacificPR đã viết:
Bạn tham khảo thử
Mã: 
Sub InBB()
    Dim Rng As Range, Cll As Range, SoBB As String
With Sheet1
    Set Rng = .Range("A11", .Range("A" & Rows.Count).End(xlUp))
End With
With Sheet2
    For Each Cll In Rng
        If Cll.Value <> Empty And IsNumeric(Cll.Value) Then
            .Range("N55").Value = Cll.Value
            .PrintPreview
            SoBB = .Range("A53").Value
            If InStrRev(SoBB, "VC", -1, vbBinaryCompare) > 0 Then
                Sheet3.PrintPreview: Sheet4.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "ATGT", -1, vbBinaryCompare) > 0 Then
                Sheet5.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "BT", -1, vbBinaryCompare) > 0 Then
                Sheet4.PrintPreview
            End If
        End If
Tiep:
    Next
End With
End Sub
Khi nào ưng cái bụng thì thay PrintPreview bằng PrintOut nhoé
Nhấp chuột vào đây để mở rộng...
em hỏi thêm chút. bây giờ mình muốn chọn số thứ tự in biên bản thì làm thế nào ạ.... ví dụ chỉ in biên bản theo số thựu tự từ 2-5 chẳng hạn ạ
 

File đính kèm

tuan16 đã viết:
Giúp thêm em về hàm này với ạ... Em có nhiều chuỗi phải nối kiểu này.
Nhấp chuột vào đây để mở rộng...
Bạn thử cái hàm này xem sao
Mã: 
Function UniqueTextJoin(ByVal Table_Array As Range, Optional Delimiter As String) As String
    Dim sArr, Str, N As Long
    Dim Dic As Object, Tmp, Khoa As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Table_Array.Value
For Each Str In sArr
    Tmp = Split(Str, Delimiter)
    For N = 0 To UBound(Tmp)
        If Tmp(N) <> Empty Then
            Khoa = Trim(Tmp(N))
            If Not Dic.Exists(Khoa) Then Dic.Add Khoa, ""
        End If
    Next N
Next
If Dic.Count Then UniqueTextJoin = Join(Dic.Keys, Delimiter)
End Function
Mã: 
D7=UniqueTextJoin(B5:B9;", ")
 
PacificPR đã viết:
Bạn thử cái hàm này xem sao
Mã: 
Function UniqueTextJoin(ByVal Table_Array As Range, Optional Delimiter As String) As String
    Dim sArr, Str, N As Long
    Dim Dic As Object, Tmp, Khoa As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Table_Array.Value
For Each Str In sArr
    Tmp = Split(Str, Delimiter)
    For N = 0 To UBound(Tmp)
        If Tmp(N) <> Empty Then
            Khoa = Trim(Tmp(N))
            If Not Dic.Exists(Khoa) Then Dic.Add Khoa, ""
        End If
    Next N
Next
If Dic.Count Then UniqueTextJoin = Join(Dic.Keys, Delimiter)
End Function
Mã: 
D7=UniqueTextJoin(B5:B9;", ")
Nhấp chuột vào đây để mở rộng...
PacificPR đã viết:
Bạn thử cái hàm này xem sao
Mã: 
Function UniqueTextJoin(ByVal Table_Array As Range, Optional Delimiter As String) As String
    Dim sArr, Str, N As Long
    Dim Dic As Object, Tmp, Khoa As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Table_Array.Value
For Each Str In sArr
    Tmp = Split(Str, Delimiter)
    For N = 0 To UBound(Tmp)
        If Tmp(N) <> Empty Then
            Khoa = Trim(Tmp(N))
            If Not Dic.Exists(Khoa) Then Dic.Add Khoa, ""
        End If
    Next N
Next
If Dic.Count Then UniqueTextJoin = Join(Dic.Keys, Delimiter)
End Function
Mã: 
D7=UniqueTextJoin(B5:B9;", ")
Nhấp chuột vào đây để mở rộng...
Em copy vào sao mà nó không chạy ra được kết quả mong muốn ạ
 

File đính kèm

tuan16 đã viết:
Em hỏi thêm bác về cách tính này với ạ
Nhấp chuột vào đây để mở rộng...
Thêm nhiều thế :p:p:p
Mã: 
Function SumDate(ByVal Date_value As Date, _
        ByVal Table_Lookup As Range, ByVal Col_Index As Long) As Long
    Dim sArr(), i As Long, fDate As Date, eDate As Date, Sum_Date As Long
sArr = Table_Lookup.Value
For i = 1 To UBound(sArr)
    If sArr(i, Col_Index) <> Empty Then
        fDate = sArr(i, 1): eDate = sArr(i, 2)
        If Date_value <= eDate Then
            If Date_value >= fDate Then
                Sum_Date = sArr(i, Col_Index) + Sum_Date
            End If
        End If
    End If
Next i
SumDate = Sum_Date
End Function
 

File đính kèm

PacificPR đã viết:
Thêm nhiều thế :p:p:p
Mã: 
Function SumDate(ByVal Date_value As Date, _
        ByVal Table_Lookup As Range, ByVal Col_Index As Long) As Long
    Dim sArr(), i As Long, fDate As Date, eDate As Date, Sum_Date As Long
sArr = Table_Lookup.Value
For i = 1 To UBound(sArr)
    If sArr(i, Col_Index) <> Empty Then
        fDate = sArr(i, 1): eDate = sArr(i, 2)
        If Date_value <= eDate Then
            If Date_value >= fDate Then
                Sum_Date = sArr(i, Col_Index) + Sum_Date
            End If
        End If
    End If
Next i
SumDate = Sum_Date
End Function
Nhấp chuột vào đây để mở rộng...
em mong muốn ngày 23/02/2020 là 5 ạ. kiểu như là 19/02/2020 đến 23/02/2020 là 2 người... từ ngày 23/02/2020 đến ngày 26/02/2020 là 5 người.. thì ngày 23/02/2020 sẽ lấy bằng với giá trị bắt của công việc bắt đầu sau. theo công thức của anh thì đang là 7 mất rồi ạ
Bài đã được tự động gộp:

tuan16 đã viết:
em mong muốn ngày 23/02/2020 là 5 ạ. kiểu như là 19/02/2020 đến 23/02/2020 là 2 người... từ ngày 23/02/2020 đến ngày 26/02/2020 là 5 người.. thì ngày 23/02/2020 sẽ lấy bằng với giá trị bắt của công việc bắt đầu sau. theo công thức của anh thì đang là 7 mất rồi ạ
Nhấp chuột vào đây để mở rộng...
giá trị của ngày 23/02/2020 được gán trong ô G5 để mình có thể thay đổi ngày trong ô đó ạ
 
tuan16 đã viết:
em mong muốn ngày 23/02/2020 là 5 ạ. kiểu như là 19/02/2020 đến 23/02/2020 là 2 người... từ ngày 23/02/2020 đến ngày 26/02/2020 là 5 người.. thì ngày 23/02/2020 sẽ lấy bằng với giá trị bắt của công việc bắt đầu sau. theo công thức của anh thì đang là 7 mất rồi ạ
Bài đã được tự động gộp:


giá trị của ngày 23/02/2020 được gán trong ô G5 để mình có thể thay đổi ngày trong ô đó ạ
Nhấp chuột vào đây để mở rộng...
ngày 23/2/2020 có 2 em
+ em 1 nhân công =2
+ em 2 nhân công = 5
Vậy nó phải = 7 chứ sao lại = 5
 
PacificPR đã viết:
ngày 23/2/2020 có 2 em
+ em 1 nhân công =2
+ em 2 nhân công = 5
Vậy nó phải = 7 chứ sao lại = 5
Nhấp chuột vào đây để mở rộng...
dạ. em muốn để ngày 23/02/2020 nghiệm thu công việc đào móng rồi thì nhân công chỉ lấy theo nhân công thực hiện công việc xây tường móng
 
tuan16 đã viết:
dạ. em muốn để ngày 23/02/2020 nghiệm thu công việc đào móng rồi thì nhân công chỉ lấy theo nhân công thực hiện công việc xây tường móng
Nhấp chuột vào đây để mở rộng...
Bạn lấy C7=D6+1
Còn không thì thay If Date_value <= eDate Then thành If Date_value < eDate Then thử xem sao
Mình thì bố trí dữ liệu kiểu này
1589014750341.png​
 
PacificPR đã viết:
Bạn lấy C7=D6+1
Còn không thì thay If Date_value <= eDate Then thành If Date_value < eDate Then thử xem sao
Mình thì bố trí dữ liệu kiểu này
Nhấp chuột vào đây để mở rộng...
PacificPR đã viết:
Bạn lấy C7=D6+1
Còn không thì thay If Date_value <= eDate Then thành If Date_value < eDate Then thử xem sao
Mình thì bố trí dữ liệu kiểu này
Nhấp chuột vào đây để mở rộng...
dạ. em sửa theo bác rồi ạ. Nhưng có vẻ chưa được tổng quát ạ. Khi có công việc thi công và nghiệm thu trong cùng ngày kết quả trả về 0. Bác xem giúp em với ạ
 

File đính kèm

tuan16 đã viết:
dạ. em sửa theo bác rồi ạ. Nhưng có vẻ chưa được tổng quát ạ. Khi có công việc thi công và nghiệm thu trong cùng ngày kết quả trả về 0. Bác xem giúp em với ạ
Nhấp chuột vào đây để mở rộng...
Bạn thêm dòng If fDate = eDate Then eDate = eDate + 1 vào dưới dòng fDate = sArr(i, 1): eDate = sArr(i, 2) xem sao
 
PacificPR đã viết:
Tốt nhất là Bạn làm thêm 1 cột ngày nghiệm thu nữa.
Nhấp chuột vào đây để mở rộng...
Dạ... Ngày nghiệm thu thì em có 1 cột riêng rồi ạ. Với đoạn code trên của bác khi em thử với ngày 26/02/2020 thì bị lỗi trả về giá trị bằng 0. Nhờ bác sửa thêm đoạn code em với ạ
 
tuan16 đã viết:
Dạ... Ngày nghiệm thu thì em có 1 cột riêng rồi ạ. Với đoạn code trên của bác khi em thử với ngày 26/02/2020 thì bị lỗi trả về giá trị bằng 0. Nhờ bác sửa thêm đoạn code em với ạ
Nhấp chuột vào đây để mở rộng...
Vậy thì mình đầu hàng rồi. Bạn gắng chờ có các Anh (Chị) khác ngang qua giúp đỡ nhé
 
PacificPR đã viết:
Vậy thì mình đầu hàng rồi. Bạn gắng chờ có các Anh (Chị) khác ngang qua giúp đỡ nhé
Nhấp chuột vào đây để mở rộng...
có anh trên diễn đàn viết cho công thức này ạ. bác xem có thể giúp em lấy giá trị cần lấy theo ngày tháng ô G5 được không ạ
 

File đính kèm

PacificPR đã viết:
Bạn tham khảo thử
Mã: 
Sub InBB()
    Dim Rng As Range, Cll As Range, SoBB As String
With Sheet1
    Set Rng = .Range("A11", .Range("A" & Rows.Count).End(xlUp))
End With
With Sheet2
    For Each Cll In Rng
        If Cll.Value <> Empty And IsNumeric(Cll.Value) Then
            .Range("N55").Value = Cll.Value
            .PrintPreview
            SoBB = .Range("A53").Value
            If InStrRev(SoBB, "VC", -1, vbBinaryCompare) > 0 Then
                Sheet3.PrintPreview: Sheet4.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "ATGT", -1, vbBinaryCompare) > 0 Then
                Sheet5.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "BT", -1, vbBinaryCompare) > 0 Then
                Sheet4.PrintPreview
            End If
        End If
Tiep:
    Next
End With
End Sub
Khi nào ưng cái bụng thì thay PrintPreview bằng PrintOut nhoé
Nhấp chuột vào đây để mở rộng...
với đoạn code trên em muốn gọi code ẩn hiện dòng ở sheet3 thì mình thêm vào đâu ạ. bác hướng dẫn em với ạ
 
PacificPR đã viết:
Bạn tham khảo thử
Mã: 
Sub InBB()
    Dim Rng As Range, Cll As Range, SoBB As String
With Sheet1
    Set Rng = .Range("A11", .Range("A" & Rows.Count).End(xlUp))
End With
With Sheet2
    For Each Cll In Rng
        If Cll.Value <> Empty And IsNumeric(Cll.Value) Then
            .Range("N55").Value = Cll.Value
            .PrintPreview
            SoBB = .Range("A53").Value
            If InStrRev(SoBB, "VC", -1, vbBinaryCompare) > 0 Then
                Sheet3.PrintPreview: Sheet4.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "ATGT", -1, vbBinaryCompare) > 0 Then
                Sheet5.PrintPreview: GoTo Tiep
            End If
            If InStrRev(SoBB, "BT", -1, vbBinaryCompare) > 0 Then
                Sheet4.PrintPreview
            End If
        End If
Tiep:
    Next
End With
End Sub
Khi nào ưng cái bụng thì thay PrintPreview bằng PrintOut nhoé
Nhấp chuột vào đây để mở rộng...
Em nhờ bác giúp thêm code này ạ. Khi ô a53 không phải là các giá trị VC,ATGT hay BT thì cần thêm gì vào đoạn code để chạy liên tục được ạ
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên
    • Cảm ơn
Trả lời
3
Đọc
186
A-T
A
T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu (1 người xem)
    • Cười
Trả lời
2
Đọc
75
HUONGHCKT
H
F
Mấy cao thủ giúp dùm mình với. File excel bị lỗi mà mình không biết lỗi chỗ nào để sửa.
Trả lời
2
Đọc
59
firstbood
F
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (8 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
438
Đọc
58K
sát thủ uyên ương
S
X
Làm thế nào để ẩn "Blank" trong Pivot table
    • Thích
Trả lời
15
Đọc
36K
nguyenngochieu761321
nguyenngochieu761321
V
Quản lý xuất nhập vật tư trong kho (3 người xem)
Trả lời
17
Đọc
684
LOGANWover
L
H
Đánh số thự theo lượt (1 người xem)
Trả lời
5
Đọc
127
hongminh_0306
H
D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL
Trả lời
2
Đọc
174
danhpheo
D
A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show (1 người xem)
Trả lời
2
Đọc
130
AnhThu-1976
A
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ.
Trả lời
5
Đọc
192
truc.duong87
T
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
1
Đọc
141
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới. (1 người xem)
Trả lời
7
Đọc
330
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter (1 người xem)
Trả lời
8
Đọc
196
eagle12
E
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
438
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
123
Nam168
Nam168
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder
    • Thích
Trả lời
0
Đọc
136
phuongnam366377
phuongnam366377
N
Định mức nguyên vật liệu (1 người xem)
Trả lời
49
Đọc
5K
ntan50
N
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột (1 người xem)
Trả lời
6
Đọc
346
Chả_biết_gì
C
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom