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

diennv50 · 6/5/20

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.

PacificPR · 7/5/20

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.

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é

tuan16 · 7/5/20

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é

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 ạ

PacificPR · 7/5/20

tuan16 đã viết:
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 ạ

Bạn có muốn cái Form như thế này không

tuan16 · 7/5/20

PacificPR đã viết:
Bạn có muốn cái Form như thế này không

View attachment 236957

dạ vâng... hướng dẫn em với ạ... em cũng đang muốn làm 1 forrm như này trên biên bản trên. vậy thêm code như nào ạ

PacificPR · 7/5/20

tuan16 đã viết:
dạ vâng... hướng dẫn em với ạ... em cũng đang muốn làm 1 forrm như này trên biên bản trên. vậy thêm code như nào ạ

Thái Lọ nhà mình sao mà chán thế. Viết cho đúng chính tả tí coi nào

tuan16 · 7/5/20

PacificPR đã viết:
Thái Lọ nhà mình sao mà chán thế. Viết cho đúng chính tả tí coi nào

Hướng dẫn em với ạ.

PacificPR · 7/5/20

tuan16 đã viết:
Hướng dẫn em với ạ.

Để chiều nhé Bạn. Giờ phải đi mâm mân mất rồi

tuan16 · 7/5/20

PacificPR đã viết:
Để chiều nhé Bạn. Giờ phải đi mâm mân mất rồi

giúp em cái form như này với ạ. Khi mình ấn vào nút Print hiện ra một Form để mình chọn in từ biên bản này đến biên bản kia. Em làm mà nó không chạy được

PacificPR · 7/5/20

tuan16 đã viết:
giúp em cái form như này với ạ. Khi mình ấn vào nút Print hiện ra một Form để mình chọn in từ biên bản này đến biên bản kia. Em làm mà nó không chạy được

Bạn tải File Bài 8 xem thử

tuan16 · 7/5/20

PacificPR đã viết:
Bạn tải File Bài 8 xem thử

Đúng rồi ạ. Em cảm ơn nhiều ạ

tuan16 · 7/5/20

PacificPR đã viết:
Bạn tải File Bài 8 xem thử

Dạ... Có hàm nào xử lý được chuỗi dữ liệu này không ạ

PacificPR · 7/5/20

tuan16 đã viết:
Dạ... Có hàm nào xử lý được chuỗi dữ liệu này không ạ

Hàm độ thì có Bạn à

tuan16 · 7/5/20

PacificPR đã viết:
Hàm độ thì có Bạn à

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.

PacificPR · 7/5/20

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.

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;", ")

tuan16 · 7/5/20

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;", ")

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;", ")

Em copy vào sao mà nó không chạy ra được kết quả mong muốn ạ

PacificPR · 7/5/20

tuan16 đã viết:
Em copy vào sao mà nó không chạy ra được kết quả mong muốn ạ

Uổi. Bây giờ mới đọc lại hoá ra Bạn không phải là Chủ Topic.

tuan16 · 7/5/20

PacificPR đã viết:
Uổi. Bây giờ mới đọc lại hoá ra Bạn không phải là Chủ Topic.

Em vào diễn đàn thấy có bạn thắc mắc giống mình nên tham gia topic luôn... Em cảm ơn bác nhiều

tuan16 · 9/5/20

PacificPR đã viết:
Uổi. Bây giờ mới đọc lại hoá ra Bạn không phải là Chủ Topic.

Em hỏi thêm bác về cách tính này với ạ

PacificPR · 9/5/20

tuan16 đã viết:
Em hỏi thêm bác về cách tính này với ạ

Thêm nhiều thế

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ờ giúp tạo macro in theo list hồ sơ, có quy định sheet in theo mỗi số thứ tự

Thành viên mới

File đính kèm

Thành viên mới

Thành viên thường trực

Thành viên mới

Thành viên thường trực

Thành viên mới

Thành viên thường trực

Thành viên mới

File đính kèm

Thành viên thường trực

File đính kèm

Thành viên mới

Thành viên thường trực

Thành viên thường trực

File đính kèm

Thành viên mới

Thành viên thường trực

Thành viên mới

Thành viên thường trực

File đính kèm

Thành viên mới

File đính kèm

Thành viên thường trực

Thành viên thường trực

File đính kèm

Thành viên mới

File đính kèm

Facebook

Group