Chọn Vùng In Có Điều Kiện (1 người xem)

tuantu315 · 4/11/21

Chào Anh/Chị Diễn Đàn mong anh chị giúp em thu gọn code hoặc có code nào giải quyết vấn đề chọ vùng in khi thỏa mãn diều kiện cho trước.
Em có viết 1 đoạn code như bên dưới để chọn vùng để in nhưng vấn đề gặp phải là code em quá dài và ko hiệu quả. Em có gởi file lên mong Anh/Chị giúp đỡ . Thanks Ạ

if sheet5.range("A1") >< "" then
Worksheets("Sheet5").PageSetup.PrintArea = "A1:A3"
end if
if sheet5.range("c1") >< "" then
Worksheets("Sheet5").PageSetup.PrintArea = "A1:C3"
end if
........................>

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
Chào Anh/Chị Diễn Đàn mong anh chị giúp em thu gọn code hoặc có code nào giải quyết vấn đề chọ vùng in khi thỏa mãn diều kiện cho trước.
Em có viết 1 đoạn code như bên dưới để chọn vùng để in nhưng vấn đề gặp phải là code em quá dài và ko hiệu quả. Em có gởi file lên mong Anh/Chị giúp đỡ . Thanks Ạ

if sheet5.range("A1") >< "" then
Worksheets("Sheet5").PageSetup.PrintArea = "A1:A3"
end if
if sheet5.range("c1") >< "" then
Worksheets("Sheet5").PageSetup.PrintArea = "A1:C3"
end if
........................>

Nếu A1<>""
C1<>""
A5<>""
A9<>""
I13<>""
Còn lại là trống thì vùng in như nào?
A1:J16 à?

Maika8008 · 4/11/21

Ủa, toán tử khác của VBA nay bị đổi rồi hả ta?

BuiQuangThuan · 4/11/21

Maika8008 đã viết:
Ủa, toán tử khác của VBA nay bị đổi rồi hả ta?

Bác hỏi em hả? Hihi
À không. Giờ mới để ý. Cái khác của thớt nó khác và đúng không phải là khác. Nó khác cái khác thật.

tuantu315 · 4/11/21

BuiQuangThuan đã viết:
Nếu A1<>""
C1<>""
A5<>""
A9<>""
I13<>""
Còn lại là trống thì vùng in như nào?
A1:J16 à?

Dạ anh xem file cho dễ hiểu ạ.
khi các Ô : A1, C1, E1 ,G1, I1, K1, M1, A5, C5, E5 ,G5, I5, K5, M5
A9, C9, E9,G9, I9, K9, M9
A13, C13, E13,G13, I13, K13, M13
Có dữ liệu thì vùng in sẽ được chọn
Ví dụ:
Ô: A1 # "" thì vùng in sẽ chọn là A1:A3
C1 # "" thì vùng in sẽ chọn A1:C3
E1 # "" thì vùng in sẽ chọn A1:E3
................................................> M13
*Note:
Giả Sử Ô A1 = "" và Ô C1 # "" thì vùng in vẫn sẽ là A1:C3 . Thanks Anh/Chị rất nhiều ạ

Bài đã được tự động gộp: 4/11/21

Maika8008 đã viết:
Ủa, toán tử khác của VBA nay bị đổi rồi hả ta?

Bác rãnh giúp em vs Ạ do lỗi typing....

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
Dạ anh xem file cho dễ hiểu ạ.
khi các Ô : A1, C1, E1 ,G1, I1, K1, M1, A5, C5, E5 ,G5, I5, K5, M5
A9, C9, E9,G9, I9, K9, M9
A13, C13, E13,G13, I13, K13, M13
Có dữ liệu thì vùng in sẽ được chọn
Ví dụ:
Ô: A1 # "" thì vùng in sẽ chọn là A1:A3
C1 # "" thì vùng in sẽ chọn A1:C3
E1 # "" thì vùng in sẽ chọn A1:E3
................................................> M13
*Note:
Giả Sử Ô A1 = "" và Ô C1 # "" thì vùng in vẫn sẽ là A1:C3 . Thanks Anh/Chị rất nhiều ạ

Bài đã được tự động gộp: 4/11/21

Bác rãnh giúp em vs Ạ do lỗi typing....

Mình chưa có hiểu rõ quy luật chọn vùng in như thế nào của bạn. Cái bạn đưa ra mới chỉ là 1 trường hợp. Hãy trả lời cái mình hỏi để xem mình nghĩ có đúng không đã chứ đừng bắt mình đoán ý của bạn

Maika8008 · 4/11/21

BuiQuangThuan đã viết:
Mình chưa có hiểu rõ quy luật chọn vùng in như thế nào của bạn. Cái bạn đưa ra mới chỉ là 1 trường hợp. Hãy trả lời cái mình hỏi để xem mình nghĩ có đúng không đã chứ đừng bắt mình đoán ý của bạn

Tôi nghĩ là cứ quét từ ô dưới cùng lên, gặp ô khác rỗng là chọn vùng đến đó

tuantu315 · 4/11/21

BuiQuangThuan đã viết:
Mình chưa có hiểu rõ quy luật chọn vùng in như thế nào của bạn. Cái bạn đưa ra mới chỉ là 1 trường hợp. Hãy trả lời cái mình hỏi để xem mình nghĩ có đúng không đã chứ đừng bắt mình đoán ý của bạn

Nếu A1<>""
C1<>""
A5<>""
A9<>""
I13<>""
Còn lại là trống thì vùng in như nào?
A1:J16 à?
Xin trả lởi câu hỏi của anh ạ:
Vậy vùng in sẽ là A1 : A3 , C1:C3, A5:A7, A9:A11, I13:I15
--> trường hợp như vậy sẽ không thể xảy ra ạ tại vì em đã bắt lỗi ngay từ đầu nên dữ liệu sẽ theo thứ tự là:
A1, C1, E1 ,G1, I1, K1, M1, A5, C5, E5 ,G5, I5, K5, M5 ,A9, C9, E9,G9, I9, K9, M9 , A13, C13, E13,G13, I13, K13, M13
Ô A1 bắt buộc phải có dữ liệu rồi đến Ô C1 và Ô E1 .... Không thể nào Ô E1 có dữ liệu mà Ô C1 vs Ô A1 trống

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
A1, C1, E1 ,G1, I1, K1, M1<>""

và A5<>"" thì chọn vùng nào?
Vùng A1:N8 đúng không?

tuantu315 · 4/11/21

BuiQuangThuan đã viết:
và A5<>"" thì chọn vùng nào?
Vùng A1:N8 đúng không?

Dạ là vùng A1:M3 và A5 : A7 ạ

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
Dạ là vùng A1:M3 và A5 : A7 ạ

Mình thấy trong file của bạn sao mấy cái ô nó lại có dấu cách nhỉ

tuantu315 · 4/11/21

BuiQuangThuan đã viết:
Mình thấy trong file của bạn sao mấy cái ô nó lại có dấu cách nhỉ

Dạ Anh thấy ở ô nào Ạ xem em xem ko thấy!!1

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
Dạ Anh thấy ở ô nào Ạ xem em xem ko thấy!!1

Thử code này coi

Mã:

Sub ABC()
    Dim Rng As Range, Vung As Range, T
    With Sheets("in tem")
        For Each Rng In Range("A1:M1,A5:M5,A9:M9,A13:M13")
            If Rng.Value <> "" Then
                Set Vung = Union(Rng, Rng.Resize(3, 1))
                T = T & "," & Vung.Address
            End If
        Next
        .PageSetup.PrintArea = Right(T, Len(T) - 1)
    End With
End Sub

tuantu315 · 4/11/21

BuiQuangThuan đã viết:

Thử code này coi

Mã:

Sub ABC()
    Dim Rng As Range, Vung As Range, T
    With Sheets("in tem")
        For Each Rng In Range("A1:M1,A5:M5,A9:M9,A13:M13")
            If Rng.Value <> "" Then
                Set Vung = Union(Rng, Rng.Resize(3, 1))
                T = T & "," & Vung.Address
            End If
        Next
        .PageSetup.PrintArea = Right(T, Len(T) - 1) Báo lỗi Unable to set the print area property ò the page set up class
    End With
End Sub

Note: Dim Rng As Range, Vung As Range, T& nếu để như vậy thì báo lỗi type missed nên em bỏ dấu & sửa lại là Dim Rng As Range, Vung As Range, T thì Bị lỗi ngay dòng này rồi Anh ơi
.PageSetup.PrintArea = Right(T, Len(T) - 1) Báo lỗi Unable to set the print area property ò the page set up class

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
Note: Dim Rng As Range, Vung As Range, T& nếu để như vậy thì báo lỗi type missed nên em bỏ dấu & sửa lại là Dim Rng As Range, Vung As Range, T thì Bị lỗi ngay dòng này rồi Anh ơi
.PageSetup.PrintArea = Right(T, Len(T) - 1) Báo lỗi Unable to set the print area property ò the page set up class

Sửa lại chút

Mã:

Sub ABC()
    Dim Rng As Range, Vung As Range, T
    With Sheets("in tem")
        For Each Rng In Range("A1:M1,A5:M5,A9:M9,A13:M13")
            If Rng.Value <> "" Then
                Set Vung = Union(Rng, Rng.Resize(3, 2))
                T = T & "," & Vung.Address
            End If
        Next
        .PageSetup.PrintArea = Right(T, Len(T) - 1)
    End With
End Sub

tuantu315 · 4/11/21

BuiQuangThuan đã viết:

Sửa lại chút

Mã:

Sub ABC()
    Dim Rng As Range, Vung As Range, T
    With Sheets("in tem")
        For Each Rng In Range("A1:M1,A5:M5,A9:M9,A13:M13")
            If Rng.Value <> "" Then
                Set Vung = Union(Rng, Rng.Resize(3, 2))
                T = T & "," & Vung.Address
            End If
        Next
        .PageSetup.PrintArea = Right(T, Len(T) - 1)
    End With
End Sub

.PageSetup.PrintArea = Right(T, Len(T) - 1) dòng này báo lỗi Unable to set the print area property ò the page set up class

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
.PageSetup.PrintArea = Right(T, Len(T) - 1) dòng này báo lỗi Unable to set the print area property ò the page set up class

bên máy mình không có bị vậy

tuantu315 · 4/11/21

BuiQuangThuan đã viết:
bên máy mình không có bị vậy

Bị lỗi này nè Anh.. Anh xài excel bao nhiêu dạ, em xài 2007

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
Bị lỗi này nè Anh.. Anh xài excel bao nhiêu dạ, em xài 2007

Mình sài 2013, Mình cho chạy code nó ra như cái hình kia đó. Rồi chẳng biết có phải ý bạn như kia ko nữa

tuantu315 · 4/11/21

BuiQuangThuan đã viết:
Mình sài 2013, Mình cho chạy code nó ra như cái hình kia đó. Rồi chẳng biết có phải ý bạn như kia ko nữa

Dạ đúng rồi đó ạ nhưng em chạy code bên 2007 ko dc

BuiQuangThuan · 4/11/21

tuantu315 đã viết:
g em chạy code bên 2007 ko d

...........

giaiphap · 4/11/21

tuantu315 đã viết:
Dạ đúng rồi đó ạ nhưng em chạy code bên 2007 ko dc

Trước lệnh

Mã:

.PageSetup.PrintArea = Right(T, Len(T) - 1)

thử thêm cái này xem nó ra cái quái gì?

Mã:

Msgbox Right(T, Len(T) - 1)

tuantu315 · 4/11/21

giaiphap đã viết:
Trước lệnh

Mã:

.PageSetup.PrintArea = Right(T, Len(T) - 1)

thử thêm cái này xem nó ra cái quái gì?

Mã:

Msgbox Right(T, Len(T) - 1)

Ra như hình này nè Anh

BuiQuangThuan · 4/11/21

giaiphap đã viết:
Trước lệnh

Mã:

.PageSetup.PrintArea = Right(T, Len(T) - 1)

thử thêm cái này xem nó ra cái quái gì?

Mã:

Msgbox Right(T, Len(T) - 1)

Trong mấy cái ô xét điều kiện. Nhìn là rỗng. Nhưng không phải là rỗng

giaiphap · 4/11/21

tuantu315 đã viết:
Ra như hình này nè Anh
View attachment 268774

Thử thế này xem.

Mã:

Sub ABC()
    Dim Rng As Range, Vung As Range
    With Sheets("in tem")
        For Each Rng In Range("A1:M1,A5:M5,A9:M9,A13:M13")
            If Rng.Value <> "" Then
                If Vung Is Nothing Then
                    Set Vung = Rng.Resize(3, 2)
                Else
                    Set Vung = Union(Vung, Rng.Resize(3, 2))
                End If
            End If
        Next
        .PageSetup.PrintArea = Vung.Address
    End With
End Sub

BuiQuangThuan · 4/11/21

giaiphap đã viết:

Thử thế này xem.

Mã:

Sub ABC()
    Dim Rng As Range, Vung As Range
    With Sheets("in tem")
        For Each Rng In Range("A1:M1,A5:M5,A9:M9,A13:M13")
            If Rng.Value <> "" Then
                If Vung Is Nothing Then
                    Set Vung = Rng.Resize(3, 2)
                Else
                    Set Vung = Union(Vung, Rng.Resize(3, 2))
                End If
            End If
        Next
        .PageSetup.PrintArea = Vung.Address
    End With
End Sub

Đúng thế này mới chuẩn này. Lần trước nhìn thấy bác SA làm thế này mà em không nhớ nổi.

Mr.hieudoanxd · 4/11/21

Mình hay làm như thế này, tạo hàm phụ AdressCell để xác định vị trí in

Function AdressCell(Rng As Range) As String
On Error Resume Next
    Dim kq1 As String, kq2 As String, m As Long
    m = Rng.count
    kq1 = NtC(Rng.Cells(1).Column) & Rng.Cells(1).Row
    kq2 = NtC(Rng.Cells(m).Column) & Rng.Cells(m).Row
    If m = 1 Then
        AdressCell = kq1
    Else
        AdressCell = kq1 & ":" & kq2
    End If
End Function

Private Function NtC(number As Long) As String
On Error Resume Next
    Dim aSplit As Variant
    aSplit = VBA.Split(Cells(1, number).Address, "$")
    NtC = aSplit(1)
End Function

sau đó nối các vùng trên lại để ra vùng in tổng bằng hàm phụ JoinText

Function JoinText(Area As Range,  Delimiter As String, Optional ByVal Only As Long = 1, Optional ByVal ignore_empty As Long = 1)
    On Error Resume Next
    Dim Rng As Range, kq As String
    For Each Rng In Area
        If ignore_empty = 1 Then
            If Rng = VBA.vbNullString Then
                kq = kq
            Else
                If Only <> 1 Then
                    If VBA.InStr(kq, Rng & Delimiter) = 0 Then ', vbBinaryCompare
                        kq = kq & Rng & Delimiter
                    Else: kq = kq
                    End If
                Else: kq = kq & Rng & Delimiter
                End If
            End If
        Else: kq = kq & Rng & Delimiter
        End If
    Next Rng

    If kq = VBA.vbNullString Then
        kq = VBA.vbNullString
    Else
        kq = VBA.Left(kq, VBA.Len(kq) - VBA.Len(Delimiter))
    End If
   
    JoinText = kq
End Function

sau khi xác định được vùng in rồi thì lúc này vùng setup vùng in:

ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.PrintArea = Range(".........").value

Maika8008 · 5/11/21

Mr.hieudoanxd đã viết:
Mình hay làm như thế này, tạo hàm phụ AdressCell để xác định vị trí in
Function AdressCell(Rng As Range) As String On Error Resume Next Dim kq1 As String, kq2 As String, m As Long m = Rng.count kq1 = NtC(Rng.Cells(1).Column) & Rng.Cells(1).Row kq2 = NtC(Rng.Cells(m).Column) & Rng.Cells(m).Row If m = 1 Then AdressCell = kq1 Else AdressCell = kq1 & ":" & kq2 End If End Function Private Function NtC(number As Long) As String On Error Resume Next Dim aSplit As Variant aSplit = VBA.Split(Cells(1, number).Address, "$") NtC = aSplit(1) End Function

sau đó nối các vùng trên lại để ra vùng in tổng bằng hàm phụ JoinText
Function JoinText(Area As Range, Delimiter As String, Optional ByVal Only As Long = 1, Optional ByVal ignore_empty As Long = 1) On Error Resume Next Dim Rng As Range, kq As String For Each Rng In Area If ignore_empty = 1 Then If Rng = VBA.vbNullString Then kq = kq Else If Only <> 1 Then If VBA.InStr(kq, Rng & Delimiter) = 0 Then ', vbBinaryCompare kq = kq & Rng & Delimiter Else: kq = kq End If Else: kq = kq & Rng & Delimiter End If End If Else: kq = kq & Rng & Delimiter End If Next Rng If kq = VBA.vbNullString Then kq = VBA.vbNullString Else kq = VBA.Left(kq, VBA.Len(kq) - VBA.Len(Delimiter)) End If JoinText = kq End Function

sau khi xác định được vùng in rồi thì lúc này vùng setup vùng in:
ActiveSheet.PageSetup.PrintArea = "" ActiveSheet.PageSetup.PrintArea = Range(".........").value

Tại sao bạn phải thêm VBA. trước các hàm, thậm chí trước hằng vbNullString luôn?

Mr.hieudoanxd · 5/11/21

Maika8008 đã viết:
Tại sao bạn phải thêm VBA. trước các hàm, thậm chí trước hằng vbNullString luôn?

Em đọc ở trên diễn đàn có người viết là thêm vba. tốc độ sẽ nhanh hơn mà ko tìm được bài viết đó dẫn cho a xem

Maika8008 · 5/11/21

Mr.hieudoanxd đã viết:
Em đọc ở trên diễn đàn có người viết là thêm vba. tốc độ sẽ nhanh hơn mà ko tìm được bài viết đó dẫn cho a xem

Tôi thấy không có sách nào (mà tôi đã đọc) viết thế và các chuyên gia trên GPE không ai dùng code kiểu như thế nên chắc là không có chuyện cải thiện tốc độ đâu. Nó làm cho việc viết code chậm hơn thì có.

giaiphap · 5/11/21

Maika8008 đã viết:
Tại sao bạn phải thêm VBA. trước các hàm, thậm chí trước hằng vbNullString luôn?

Tôi thấy có cái lợi là khi gõ VBA xong "." một cái là nó liệt kê các hàm mà không cần phải nhớ tên chi tiết của hàm.

tuantu315 · 5/11/21

giaiphap đã viết:

Thử thế này xem.

Mã:

Sub ABC()
    Dim Rng As Range, Vung As Range
    With Sheets("in tem")
        For Each Rng In Range("A1:M1,A5:M5,A9:M9,A13:M13")
            If Rng.Value <> "" Then
                If Vung Is Nothing Then
                    Set Vung = Rng.Resize(3, 2)
                Else
                    Set Vung = Union(Vung, Rng.Resize(3, 2))
                End If
            End If
        Next
        .PageSetup.PrintArea = Vung.Address
    End With
End Sub

Thanks Anh nhiều !! Em làm được rồi ạ

Bài đã được tự động gộp: 5/11/21

Mr.hieudoanxd đã viết:
Mình hay làm như thế này, tạo hàm phụ AdressCell để xác định vị trí in
Function AdressCell(Rng As Range) As String On Error Resume Next Dim kq1 As String, kq2 As String, m As Long m = Rng.count kq1 = NtC(Rng.Cells(1).Column) & Rng.Cells(1).Row kq2 = NtC(Rng.Cells(m).Column) & Rng.Cells(m).Row If m = 1 Then AdressCell = kq1 Else AdressCell = kq1 & ":" & kq2 End If End Function Private Function NtC(number As Long) As String On Error Resume Next Dim aSplit As Variant aSplit = VBA.Split(Cells(1, number).Address, "$") NtC = aSplit(1) End Function

sau đó nối các vùng trên lại để ra vùng in tổng bằng hàm phụ JoinText
Function JoinText(Area As Range, Delimiter As String, Optional ByVal Only As Long = 1, Optional ByVal ignore_empty As Long = 1) On Error Resume Next Dim Rng As Range, kq As String For Each Rng In Area If ignore_empty = 1 Then If Rng = VBA.vbNullString Then kq = kq Else If Only <> 1 Then If VBA.InStr(kq, Rng & Delimiter) = 0 Then ', vbBinaryCompare kq = kq & Rng & Delimiter Else: kq = kq End If Else: kq = kq & Rng & Delimiter End If End If Else: kq = kq & Rng & Delimiter End If Next Rng If kq = VBA.vbNullString Then kq = VBA.vbNullString Else kq = VBA.Left(kq, VBA.Len(kq) - VBA.Len(Delimiter)) End If JoinText = kq End Function

sau khi xác định được vùng in rồi thì lúc này vùng setup vùng in:
ActiveSheet.PageSetup.PrintArea = "" ActiveSheet.PageSetup.PrintArea = Range(".........").value

Hơi dài dòng nhưng cũng có thêm 1 cách khác nữa... Thanks nhiu ạ

Chọn Vùng In Có Điều Kiện (1 người xem)

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

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

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên gạo cội

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên gạo cội

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

==(^o^)==

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

❆❆❆❆❆❆❆❆❆❆❆❆

==(^o^)==

❆❆❆❆❆❆❆❆❆❆❆❆

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

Thành viên gạo cội

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

Thành viên gạo cội

==(^o^)==

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

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