Nhờ các bạn xem hộ Code kẻ khung sai ở đâu ? lỗi tại Range("C3", "I" & n + 2).Select (1 người xem)

[le_vis]

Option Explicit


Sub Loc()

Dim SrcArr, ResArr()
Dim lR As Long, k As Long, lMonthItem As Long, lYearItem As Long
Dim dTargetDate As Date

dTargetDate = Sheet8.Range("K1").Value2 'Sheet nhan du lieu
SrcArr = Sheet2.Range(Sheet2.Range("C4"), Sheet2.Range("C50000").End(xlUp)).Resize(, 20).Value2 'Sheet tong hop bat dau tu cot C tinh la 1
ReDim ResArr(1 To UBound(SrcArr, 1), 1 To 12) 'Pet du lieu tu cot den cot

Application.ScreenUpdating = False ' Khong che vuot qua cot 12

For lR = 1 To UBound(SrcArr, 1) 'nhan du lieu tu
If Len(SrcArr(lR, 1)) Then
lMonthItem = Month(SrcArr(lR, 2))
lYearItem = Year(SrcArr(lR, 2))
If lMonthItem = Month(dTargetDate) Then
If lYearItem = Year(dTargetDate) Then
If SrcArr(lR, 3) <> "0" Then ' "HY"khong cho copi du lieu khi da bao huy, HY cho copi
k = k + 1
If Len(SrcArr(lR, 1)) < 12 Then 'khong che 12 cot copi pet
ResArr(k, 1) = String(7 - Len(SrcArr(lR, 1)), "0") & SrcArr(lR, 1) 'khong che them bay so 0
Else
ResArr(k, 1) = SrcArr(lR, 1)
End If
ResArr(k, 2) = SrcArr(lR, 2) 'Ngay
ResArr(k, 3) = SourceToDest(SrcArr(lR, 7), 3, 1) 'Nguoi mua hang
ResArr(k, 4) = CStr(SrcArr(lR, 5)) 'Ma so thue
ResArr(k, 5) = Round(SrcArr(lR, 16), 0) 'Tien hang
ResArr(k, 6) = Round(SrcArr(lR, 17), 0) 'Tien thue
ResArr(k, 11) = SrcArr(lR, 3) 'bao huy
ResArr(k, 12) = SourceToDest(SrcArr(lR, 15), 3, 1) ' Ten hang
End If
End If
End If
End If
Next lR

If k Then
With Sheet8
.Range("C3:N10000").ClearContents 'Pet vao tu cot den cot
.Range("C3").Resize(k, 12).Value = ResArr ' nhan du lieu tu C3 den cot thu 12
End With
End If
Application.ScreenUpdating = True

End Sub
'------------------------------------------


'Ke khung
Range("C3", "I" & n + 2).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
Range("C3", "I" & n).Select
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Range("C" & n + 1, "I" & n + 1).Select
Selection.Borders(xlInsideVertical).LineStyle = xlNone

End With
End If
Application.ScreenUpdating = True

End Sub

 

[Quang_Hải]

Option Explicit

Có thể là do biến n chưa khai báo

 

[le_vis]

Cảm ơn bạn Quanghai1969. Bạn có thể giải thích rõ hơn không. Mình đang may mò mãi không được. Cảm Ơn bạn nhiều
Báo lỗi xanh ở ký tự "C3"

 

[le_vis]

Bạn ví dụ trực tiếp vào đoạn code cho mình được không ?

 

[Quang_Hải]

Bạn ví dụ trực tiếp vào đoạn code cho mình được không ?

Nếu như có cái file tạm thì may ra...

Báo lỗi xanh ở ký tự "C3"

Làm gì có báo lỗi xanh ta? Vụ này mới à nghen. Thường thường khi VBA chửi thì sẽ dùng màu vàng để chửi, nếu là màu xanh chắc là đang khen đó, không phải lỗi đâu.

 

[le_vis]

File loi phan Code ke bang

Nếu như có cái file tạm thì may ra...


Làm gì có báo lỗi xanh ta? Vụ này mới à nghen. Thường thường khi VBA chửi thì sẽ dùng màu vàng để chửi, nếu là màu xanh chắc là đang khen đó, không phải lỗi đâu.

Minh chuyển File tạm, nhờ bạn xem giúp. Trân trọng Cảm ơn nhiều

 

[Quang_Hải]

Minh chuyển File tạm, nhờ bạn xem giúp. Trân trọng Cảm ơn nhiều

Bạn thay cái rừng trong module1 bằng đám rừng mới này đi

Sub Loc()
    Dim SrcArr, ResArr()
    Dim lR As Long, k As Long, lMonthItem As Long
    Dim dTargetDate As Date, lYearItem As Long
    dTargetDate = Sheet2.Range("M1").Value2
    With Sheet1
      SrcArr = .Range(("C4"), .Range("C65000").End(3)).Resize(, 14).Value2
    End With
    ReDim ResArr(1 To UBound(SrcArr, 1), 1 To 8)
    For lR = 1 To UBound(SrcArr, 1)
        If Len(SrcArr(lR, 1)) Then
            lMonthItem = Month(SrcArr(lR, 2))
            lYearItem = Year(SrcArr(lR, 2))
            If lMonthItem = Month(dTargetDate) Then
                If lYearItem = Year(dTargetDate) Then
                    If SrcArr(lR, 3) <> "HY" Then
                        k = k + 1
                        If Len(SrcArr(lR, 1)) < 9 Then
                            ResArr(k, 1) = String(7 - Len(SrcArr(lR, 1)), "0") & SrcArr(lR, 1)
                        Else
                            ResArr(k, 1) = SrcArr(lR, 1)
                        End If
                        ResArr(k, 2) = SrcArr(lR, 2)
                        ResArr(k, 3) = SrcArr(lR, 10)
                        ResArr(k, 4) = SrcArr(lR, 11)
                        ResArr(k, 5) = SrcArr(lR, 12)
                        ResArr(k, 6) = CStr(SrcArr(lR, 5))
                        ResArr(k, 7) = SourceToDest(SrcArr(lR, 6), 3, 1)
                        ResArr(k, 8) = SrcArr(lR, 14)
                    End If
                End If
            End If
        End If
    Next lR
    If k Then
      Sheet2.Range("C3:K10000").ClearContents '......
      With Sheet2.Range("C3").Resize(k, 8)
         .Value = ResArr ' .........
         .Borders.Value = 1
         .Borders(xlInsideHorizontal).Weight = xlHairline
         .Borders(xlInsideVertical).LineStyle = xlNone
      End With
    End If
End Sub

 

[dhn46]

Lỗi "xanh" của bạn có nghĩa là: bạn đặt End Sub trên đoạn kẻ bảng, Code kẻ bảng không thuộc bất kỳ sub nào nên nó báo lỗi.

Khắc phục thì bạn cho cái chữ "En Sub" nó chuyển xuống cuối cùng sẽ hết.

 

[le_vis]

mình cảm ơn các bạn đã giúp đỡ. Mình thử lại xem . Cảm ơn các bạn nhiều lắm lắm

 

[le_vis]

Cảm ơn QuangHai1969. Code chạy chuẩn nhưng còn 2 vấn đề muốn bạn giúp thêm đó là :
1) Nó chỉ mới kẻ được viền bao và kẻ dòng, còn đường kẻ pân cột giữa không kẻ được
2) Khi thử tháng 11 có 100 dòng chẳng hạn, đến khi copi tháng 10 có 1 dòng chẳng hạn thì nó không xóa những dòng trống không có dữ liệu đi. Bạn giúp mình mới

 

[Quang_Hải]

Cảm ơn QuangHai1969. Code chạy chuẩn nhưng còn 2 vấn đề muốn bạn giúp thêm đó là :
1) Nó chỉ mới kẻ được viền bao và kẻ dòng, còn đường kẻ pân cột giữa không kẻ được
2) Khi thử tháng 11 có 100 dòng chẳng hạn, đến khi copi tháng 10 có 1 dòng chẳng hạn thì nó không xóa những dòng trống không có dữ liệu đi. Bạn giúp mình mới

Thử chỉnh lại từ đoạn If k then ....

    If k Then
      With Sheet2
         .Range("C3:K10000").ClearContents
         .Range("C3:K10000").Borders.LineStyle = xlNone
         With .Range("C3").Resize(k, 8)
            .Value = ResArr ' .........
            .Borders.Value = 1
            .Borders(xlInsideHorizontal).Weight = xlHairline
         End With
      End With
    End If

 

[le_vis]

Cảm ơn QuangHai1969. Code chạy chuẩn - Mình không được học cơ bản nên việc phát triển quả là khó khăn. Cảm ơn bạn cảm ơn sư phụ nhiều lắm. rất mong còn được bạn quan tâm nhiều nữa

 

[Quang_Hải]

Cảm ơn QuangHai1969. Code chạy chuẩn - Mình không được học cơ bản nên việc phát triển quả là khó khăn. Cảm ơn bạn cảm ơn sư phụ nhiều lắm. rất mong còn được bạn quan tâm nhiều nữa

Chứ bộ bạn tưởng là mình có học hành gì sao? 2 năm trước chỉ biết có cái hàm Vlookup. Nhờ các anh em trên GPE tận tình giúp đở cộng với nhiều công sức mò mẫm mới có tí kiến thức như bây giờ.

 

[le_vis]

Thế bạn mới đáng mặt anh tài đấy. Xin cảm phục ! Mình xét thấy có thể bản thân chỉ số IQ thấp cộng thêm tuổi tác nên cũng chịu khó mò mẫn nhưng thấy mình kém lắm quanghai1969 ạ