Xin xử lý code: Copy và Paste vào hàng nhập liệu! (1 người xem)

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)
Tôi tuân thủ nội quy khi đăng bài
Có
T

Tuan.DNa

Thành viên hoạt động
Tham gia
26/9/23
Bài viết
110
Được thích
17
Chào các Anh, Chị diễn đàn.

Mình xin code Copy và Paste vào hàng nhập liệu.
Nội dung nhờ hổ trợ có ghi theo như trong file!
- Nhập dữ liệu cột A, thì Copy và Paste từ vùng cố định vào hàng nhập liệu.
Mong Anh , Chị xem file và hổ trợ giúp mình nhé.

Cảm ơn nhiều
(Chủ đề gửi lần 2. Lần 1 bị khóa rồi)
 

File đính kèm

Không thành viên nào hổ trợ giúp mình à
 
le_vis đã viết:
Bạn đưa ra cấu trúc biểu dữ liệu như vậy chắc chẳng ai giúp được bạn đâu !!! Mà người siêng để sửa lại biểu dữ liệu thì lại rất bận; hoặc ngại
Nhấp chuột vào đây để mở rộng...
Là sao bạn. Bạn có thể hướng dẫn mình thay đổi cấu trúc dữ liệu lại được không
 
- Di chuyển chuột trong vùng B4:F10
- Các giá trị cả hàng được đưa lên vùng xanh
- Thay đổi ngày, số lượng … và Save
 

File đính kèm

Tuan.DNa đã viết:
Chào các Anh, Chị diễn đàn.

Mình xin code Copy và Paste vào hàng nhập liệu.
Nội dung nhờ hổ trợ có ghi theo như trong file!
- Nhập dữ liệu cột A, thì Copy và Paste từ vùng cố định vào hàng nhập liệu.
Mong Anh , Chị xem file và hổ trợ giúp mình nhé.

Cảm ơn nhiều
(Chủ đề gửi lần 2. Lần 1 bị khóa rồi)
Nhấp chuột vào đây để mở rộng...
Hình như bài đồng chí đặt sai box nên bị khóa. Vấn đề này rất riêng mà lại đăng vào mục "Những vấn đề chung ", và vì có ít người "chung" nên bị xóa hoặc quên lãng.

Trình bày thì khó hiểu, đây là 1 cách đoán mò:
Mã: 
Option Explicit

Sub SuKienThinhThoangBiLoiPhaiReset_KhongHieu()
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lrCong1%
Static valueTemp&
Application.EnableEvents = False
On Error GoTo Thoat
If Not Intersect(Target, Range("A3")) Is Nothing Then
If valueTemp = Target.Value2 Or Range("A3") = "" Then GoTo Thoat
valueTemp = Range("A3").Value2
lrCong1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & lrCong1).Resize(, 6).Value = Range("A3:F3").Value2
End If
Application.EnableEvents = True
Exit Sub
Thoat:
Application.EnableEvents = True
Exit Sub
End Sub
 
TongDe đã viết:
- Di chuyển chuột trong vùng B4:F10
- Các giá trị cả hàng được đưa lên vùng xanh
- Thay đổi ngày, số lượng … và Save
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bạn!
Mục đích mình là khi nhập liệu ngày tháng (Cột A), thì code tự động copy vùng (B3:F3) và Paste vào ngay hàng hiện tại, tại vị trí B.
Vì (B3:F3) là vùng mình đã đặt list rồi, để nhập liệu cho đúng.
Đối với sự kiện Change ở Cột D và if ở Cột A thì đã có code rồi.
Mong bạn hổ trợ mình nhé, nếu sửa code sự kiện Change cho hợp lý thì càng tốt.
Bài đã được tự động gộp:

cantl đã viết:
Hình như bài đồng chí đặt sai box nên bị khóa. Vấn đề này rất riêng mà lại đăng vào mục "Những vấn đề chung ", và vì có ít người "chung" nên bị xóa hoặc quên lãng.

Trình bày thì khó hiểu, đây là 1 cách đoán mò:
Mã: 
Option Explicit

Sub SuKienThinhThoangBiLoiPhaiReset_KhongHieu()
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lrCong1%
Static valueTemp&
Application.EnableEvents = False
On Error GoTo Thoat
If Not Intersect(Target, Range("A3")) Is Nothing Then
If valueTemp = Target.Value2 Or Range("A3") = "" Then GoTo Thoat
valueTemp = Range("A3").Value2
lrCong1 = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & lrCong1).Resize(, 6).Value = Range("A3:F3").Value2
End If
Application.EnableEvents = True
Exit Sub
Thoat:
Application.EnableEvents = True
Exit Sub
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bận.
Code đâu có chạy bạn ơi,
Với lại ở sheet đó mình đã có sự kiện Change rồi, giờ chen vô nữa có được không bạn.
 
Lần chỉnh sửa cuối:
Tuan.DNa đã viết:
Cảm ơn Bạn!
Mục đích mình là khi nhập liệu ngày tháng (Cột A), thì code tự động copy vùng (B3:F3) và Paste vào ngay hàng hiện tại, tại vị trí B.
Vì (B3:F3) là vùng mình đã đặt list rồi, để nhập liệu cho đúng.
Đối với sự kiện Change ở Cột D và if ở Cột A thì đã có code rồi.
Mong bạn hổ trợ mình nhé, nếu sửa code sự kiện Change cho hợp lý thì càng tốt.
Bài đã được tự động gộp:


Cảm ơn Bận.
Code đâu có chạy bạn ơi,
Với lại ở sheet đó mình đã có sự kiện Change rồi, giờ chen vô nữa có được không bạn.
Nhấp chuột vào đây để mở rộng...
À, tớ xóa hết change cũ, thay bằng code trên. (ẢNH BỊ NHẦM TÍ, PHẢI NHẬP Ô BÊN PHẢI TRƯỚC MỚI NHẬP NGÀY.)

TẠM THỜI NẾU CÓ THÊM Ý KHÁC THÌ PHẢI NGHĨ NHIỀU NỮA. :cool: :cool: :cool:



1695809005648.png
 
cantl đã viết:
À, tớ xóa hết change cũ, thay bằng code trên. (ẢNH BỊ NHẦM TÍ, PHẢI NHẬP Ô BÊN PHẢI TRƯỚC MỚI NHẬP NGÀY.)

TẠM THỜI NẾU CÓ THÊM Ý KHÁC THÌ PHẢI NGHĨ NHIỀU NỮA. :cool: :cool: :cool:



View attachment 295217
Nhấp chuột vào đây để mở rộng...
Gì đoán mò trời!
Mục đích là copy vùng (B3:F3) và Paste zô ngay hàng nhập ngày, tại vị trí B. Nhập hàng nào thì copy hàng đó (nếu làm thủ công thì mình copy sẵn hết cho 1000 dòng trước)
(B3:F3) là vùng đã có list sẵn
 
Tuan.DNa đã viết:
Gì đoán mò trời!
Mục đích là copy vùng (B3:F3) và Paste zô ngay hàng nhập ngày, tại vị trí B. Nhập hàng nào thì copy hàng đó (nếu làm thủ công thì mình copy sẵn hết cho 1000 dòng trước)
(B3:F3) là vùng đã có list sẵn
Nhấp chuột vào đây để mở rộng...
Bạn là người hỏi. Bạn phải tự biết mình cần giải thích rõ rệt, người ta mới khỏi đoán mò.

Thái độ bạn như vậy thì người ta có muốn thử giúp thôi cũng ngại.
Tuan.DNa đã viết:
Không thành viên nào hổ trợ giúp mình à
Nhấp chuột vào đây để mở rộng...
 
VetMini đã viết:
Bạn là người hỏi. Bạn phải tự biết mình cần giải thích rõ rệt, người ta mới khỏi đoán mò.

Thái độ bạn như vậy thì người ta có muốn thử giúp thôi cũng ngại.
Nhấp chuột vào đây để mở rộng...
Xin lỗi các bạn. Diễn đạt không được rõ, mong các bạn hổ trợ mình nhé!
 
TongDe đã viết:
Mỗi lần thay A3 thì copy xuống dòng cuối...
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn.
Chủ ý của mình là: nhập ngày tháng ở A7 (hàng cuối) thì Copy vùng (B3:F3) và Paste vào (B7:F7). Hoặc nhập ngày ở A10 thì Paste vào ngay hàng này......
Nhưng sửa ngày ở A5 (hàng có dữ liệu) thì không thực hiện lệnh copy.
Mong bạn hổ trợ mình nhé
 
Mình đoán ý bạn ấy là: Nhập dữ liệu vào dòng đầu. Tạo nút nhập, khi nhập liệu xong thì nhấn vào đó nó chuyển xuống dòng cuối của bảng. Phải không nhỉ
 
tranthanh2200 đã viết:
Mình đoán ý bạn ấy là: Nhập dữ liệu vào dòng đầu. Tạo nút nhập, khi nhập liệu xong thì nhấn vào đó nó chuyển xuống dòng cuối của bảng. Phải không nhỉ
Nhấp chuột vào đây để mở rộng...
Không bạn ơi.
Khi nhập ngày ở Cột A Sheets (XUAT), thì copy vùng B3:F3 và dán vào ngay hàng nhập ngày đó bạn.
 
Tuan.DNa đã viết:
Chủ ý của mình là: nhập ngày tháng ở A7 (hàng cuối) thì Copy vùng (B3:F3) và Paste vào (B7:F7). Hoặc nhập ngày ở A10 thì Paste vào ngay hàng này......
Nhưng sửa ngày ở A5 (hàng có dữ liệu) thì không thực hiện lệnh copy.
Nhấp chuột vào đây để mở rộng...
Sáng ra, làm đại 1 quả, hy vọng đúng ý.
Thay code cũ bằng code này:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim LrD As Long, i&

Set Ws = Sheets("XUAT")

LrD = Ws.Range("D65536").End(xlUp).Row
If Not Application.Intersect(Range("D4", "D" & LrD), Range(Target.Address)) Is Nothing Then
   Ws.Range("E" & ActiveCell.Row & ":" & "F" & ActiveCell.Row).ClearContents
    If Ws.Range("A" & ActiveCell.Row).Value = "" Then
       Ws.Range("C" & ActiveCell.Row & ":" & "H" & ActiveCell.Row).ClearContents
       MsgBox "De nghi nhap: Ngay, Thang, Nam...! "
    End If
End If
If Application.Intersect(Target, Ws.Range("B4:B10000")) Is Nothing Then
i = Target.Row
    If Application.WorksheetFunction.CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 Then
        Application.EnableEvents = False
        Ws.Range("B3:F3").Copy Ws.Range("B" & i)
        Application.EnableEvents = True
    End If
End If

End Sub
 
Sự kiện change khi thay đổi a6:a100 thì copy xuống
Để buộc nhập ngày... Data Validation chọn date....
 

File đính kèm

HUONGHCKT đã viết:
Sáng ra, làm đại 1 quả, hy vọng đúng ý.
Thay code cũ bằng code này:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim LrD As Long, i&

Set Ws = Sheets("XUAT")

LrD = Ws.Range("D65536").End(xlUp).Row
If Not Application.Intersect(Range("D4", "D" & LrD), Range(Target.Address)) Is Nothing Then
   Ws.Range("E" & ActiveCell.Row & ":" & "F" & ActiveCell.Row).ClearContents
    If Ws.Range("A" & ActiveCell.Row).Value = "" Then
       Ws.Range("C" & ActiveCell.Row & ":" & "H" & ActiveCell.Row).ClearContents
       MsgBox "De nghi nhap: Ngay, Thang, Nam...! "
    End If
End If
If Application.Intersect(Target, Ws.Range("B4:B10000")) Is Nothing Then
i = Target.Row
    If Application.WorksheetFunction.CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 Then
        Application.EnableEvents = False
        Ws.Range("B3:F3").Copy Ws.Range("B" & i)
        Application.EnableEvents = True
    End If
End If

End Sub
[/QUOTE]
[/QUOTE]
[automerge]1695876429[/automerge]
[QUOTE="HUONGHCKT, post: 1116207, member: 731215"]
Sáng ra,  làm đại 1 quả, hy vọng đúng ý.
Thay code cũ bằng code này:
[CODE]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim LrD As Long, i&

Set Ws = Sheets("XUAT")

LrD = Ws.Range("D65536").End(xlUp).Row
If Not Application.Intersect(Range("D4", "D" & LrD), Range(Target.Address)) Is Nothing Then
   Ws.Range("E" & ActiveCell.Row & ":" & "F" & ActiveCell.Row).ClearContents
    If Ws.Range("A" & ActiveCell.Row).Value = "" Then
       Ws.Range("C" & ActiveCell.Row & ":" & "H" & ActiveCell.Row).ClearContents
       MsgBox "De nghi nhap: Ngay, Thang, Nam...! "
    End If
End If
If Application.Intersect(Target, Ws.Range("B4:B10000")) Is Nothing Then
i = Target.Row
    If Application.WorksheetFunction.CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 Then
        Application.EnableEvents = False
        Ws.Range("B3:F3").Copy Ws.Range("B" & i)
        Application.EnableEvents = True
    End If
End If

End Sub
Nhấp chuột vào đây để mở rộng...
Đúng ý mình rồi. Bạn này giỏi gê. Cảm ơn bạn nhé.
Chỉ có 1 vấn đề: nếu cột B mã sh không nhập hoặc dl kiểu số thì không nhập được các cột tiếp theo. Vậy mình đặt X luôn trong vùng (B3:F3).
Thành thật cảm ơn bạn và các bạn nhiều nha.
Nếu còn phương pháp nào khác thì mình xin học hỏi tiếp nhé
 
Lần chỉnh sửa cuối:
HUONGHCKT đã viết:
Sáng ra, làm đại 1 quả, hy vọng đúng ý.
Thay code cũ bằng code này:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim LrD As Long, i&

Set Ws = Sheets("XUAT")

LrD = Ws.Range("D65536").End(xlUp).Row
If Not Application.Intersect(Range("D4", "D" & LrD), Range(Target.Address)) Is Nothing Then
   Ws.Range("E" & ActiveCell.Row & ":" & "F" & ActiveCell.Row).ClearContents
    If Ws.Range("A" & ActiveCell.Row).Value = "" Then
       Ws.Range("C" & ActiveCell.Row & ":" & "H" & ActiveCell.Row).ClearContents
       MsgBox "De nghi nhap: Ngay, Thang, Nam...! "
    End If
End If
If Application.Intersect(Target, Ws.Range("B4:B10000")) Is Nothing Then
i = Target.Row
    If Application.WorksheetFunction.CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 Then
        Application.EnableEvents = False
        Ws.Range("B3:F3").Copy Ws.Range("B" & i)
        Application.EnableEvents = True
    End If
End If

End Sub
Nhấp chuột vào đây để mở rộng...
" If Application.Intersect(Target, Ws.Range("B4:B10000")) Is Nothing Then
i = Target.Row
If Application.WorksheetFunction.CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 Then
Application.EnableEvents = False
Ws.Range("B3:F3").Copy Ws.Range("B" & i)
Application.EnableEvents = True
End If
End if "
Mấu chốt là câu lệnh với hàm đếm này. Hay thật!
Vấn đề vùng Range("B4:B1000") này "động" được không bạn
 
Tuan.DNa đã viết:
Mấu chốt là câu lệnh với hàm đếm này. Hay thật!
Vấn đề vùng Range("B4:B1000") này "động" được không bạn
Nhấp chuột vào đây để mở rộng...
10000 dòng cũng là rất nhiều rồi mà.
Nếu bạn muốn vùng B4:B10000 ấy "động" thì có thể dùng 1 biến để tìm dòng cuối (ví dụ : Lr=Ws.cells(Rows.count,"B")..End(xlup)).Row và thay cái số 10000 ấy = các biến dòng cuối ấy ( Range("B4"B" Lr) ) xem được không? Hoặc bạn đặt cái vùng có dữ liệu B4:b1000 thành 1 namerange xem sao?
Công thức namerange động thì chắc bạn cũng biết rồi.
 
HUONGHCKT đã viết:
10000 dòng cũng là rất nhiều rồi mà.
Nếu bạn muốn vùng B4:B10000 ấy "động" thì có thể dùng 1 biến để tìm dòng cuối (ví dụ : Lr=Ws.cells(Rows.count,"B")..End(xlup)).Row và thay cái số 10000 ấy = các biến dòng cuối ấy ( Range("B4"B" Lr) ) xem được không? Hoặc bạn đặt cái vùng có dữ liệu B4:b1000 thành 1 namerange xem sao?
Công thức namerange động thì chắc bạn cũng biết rồi.
Nhấp chuột vào đây để mở rộng...
Mình dùng hàm dòng cuối. Cảm ơn bạn đã hướng dẫn nha.
 
HUONGHCKT đã viết:
Sáng ra, làm đại 1 quả, hy vọng đúng ý.
Thay code cũ bằng code này:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim LrD As Long, i&

Set Ws = Sheets("XUAT")

LrD = Ws.Range("D65536").End(xlUp).Row
If Not Application.Intersect(Range("D4", "D" & LrD), Range(Target.Address)) Is Nothing Then
   Ws.Range("E" & ActiveCell.Row & ":" & "F" & ActiveCell.Row).ClearContents
    If Ws.Range("A" & ActiveCell.Row).Value = "" Then
       Ws.Range("C" & ActiveCell.Row & ":" & "H" & ActiveCell.Row).ClearContents
       MsgBox "De nghi nhap: Ngay, Thang, Nam...! "
    End If
End If
If Application.Intersect(Target, Ws.Range("B4:B10000")) Is Nothing Then
i = Target.Row
    If Application.WorksheetFunction.CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 Then
        Application.EnableEvents = False
        Ws.Range("B3:F3").Copy Ws.Range("B" & i)
        Application.EnableEvents = True
    End If
End If

End Sub
Nhấp chuột vào đây để mở rộng...
@HUONGHCKT , cho mình hỏi chút nhé!
Với code này, khi mình insert thêm 1 hàng trước hàng 4 thì code chỉ copy ở hàng cuối+1, nhập các hàng tiếp theo thì không copy nữa.
Nhờ bạn giải thích vì sao giúp mình nhé và cho mình hướng xử lý với. Cảm ơn bạn!
 
Tuan.DNa đã viết:
@HUONGHCKT , cho mình hỏi chút nhé!
Với code này, khi mình insert thêm 1 hàng trước hàng 4 thì code chỉ copy ở hàng cuối+1, nhập các hàng tiếp theo thì không copy nữa.
Nhờ bạn giải thích vì sao giúp mình nhé và cho mình hướng xử lý với. Cảm ơn bạn!
Nhấp chuột vào đây để mở rộng...
Bạn trông thấy chỗ này không? If ....CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 then tại sao lại phải là = 1 bởi vì cột B có công thức
Bạn chèn thêm dòng vào và cột B :F= rỗng do vậy nó end if luôn.
 
HUONGHCKT đã viết:
Bạn trông thấy chỗ này không? If ....CountIf(Ws.Range("B" & i & ":F" & i), "***") = 1 then tại sao lại phải là = 1 bởi vì cột B có công thức
Bạn chèn thêm dòng vào và cột B :F= rỗng do vậy nó end if luôn.
Nhấp chuột vào đây để mở rộng...
Mình hiểu rồi. Chừ mình muốn xử lý chổ cột B đó từ dòng B5:F theo biến i Row đó được không bạn
 
Tuan.DNa đã viết:
Mình hiểu rồi. Chừ mình muốn xử lý chổ cột B đó từ dòng B5:F theo biến i Row đó được không bạn
Nhấp chuột vào đây để mở rộng...
B5:B&dongcuoi không được, lý do đó là vùng đã có dữ liệu, có chăng bạn thử là B5:B&dongcuoi+1 hoặc 2 xem sao. Cứ thử đi, không được cách này thì ta dùng cachs khác. Cái đọng lại đó là kinh nghiệm và kiến thức vỡ vạc ra phần nào.
 
HUONGHCKT đã viết:
B5:B&dongcuoi không được, lý do đó là vùng đã có dữ liệu, có chăng bạn thử là B5:B&dongcuoi+1 hoặc 2 xem sao. Cứ thử đi, không được cách này thì ta dùng cachs khác. Cái đọng lại đó là kinh nghiệm và kiến thức vỡ vạc ra phần nào.
Nhấp chuột vào đây để mở rộng...
Ý mình là cang thiệp chổ này nè
i = Target.Row
 
Tuan.DNa đã viết:
Ý mình là cang thiệp chổ này nè
i = Target.Row
Nhấp chuột vào đây để mở rộng...
Chỗ này i=Target.row là tìm ô đang được bắt sự kiện nằm ở dòng nào thôi mà. còn ý bạn sao thì thực sự tôi không hiểu. Từ chố biết được dòng nào thì mới biết được paste chứ.
 
HUONGHCKT đã viết:
Chỗ này i=Target.row là tìm ô đang được bắt sự kiện nằm ở dòng nào thôi mà. còn ý bạn sao thì thực sự tôi không hiểu. Từ chố biết được dòng nào thì mới biết được paste chứ.
Nhấp chuột vào đây để mở rộng...
Sáng mai mình test thử và tìm cách fix chổ này. Hiện mình đang đi chơi vs bạn.
Cảm ơn bạn nhé, chúc bạn buổi tối vui vẽ!
 
Cũng với file trên. Giờ mình code cho:
1. Tự động kẻ border khi có dữ liệu.
Dim ws As Worksheet
Set ws = Worksheets("XUAT")
Dim LrD As Long
LrD = ws.Range("D65536").End(xlUp).Row

ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
2. Hàm SumProduct theo dòng có dữ liệu.
- Dán KQ Sum Product cho 3 cột J, K, L vào vùng J2:L2
- Dữ liệu cột I là cố định và nhân cho các cột J, K, L để lấy Sumproduct.
- Lấy theo dòng cuối để KQ không bị lỗi dữ liệu cho hàm Sumproduct.
Dim Rng, Rng1, Rng2, Rng3 As Range
Set Rng = ws.Range("I4:I" & LrD)
Set Rng1 = ws.Range("J4:J" & LrD)
Set Rng2 = ws.Range("K4:K" & LrD)
Set Rng3 = ws.Range(""L4:L" & LrD)

' Làm mới vùng KQ trước khi chạy SumProduct
ws.Range("J2:L2").ClearContents

' Chạy code SumProduct và Dán KQ
ws.Range("J2") = Application.WorksheetFunction.SumProduct(Rng, Rng1)
ws.Range("K2") = Application.WorksheetFunction.SumProduct(Rng, Rng2)
ws.Range("L2") = Application.WorksheetFunction.SumProduct(Rng, Rng3)
------------------------
Với 2 code trên, nhờ Diễn đàn xem có tối ưu không, hoặc có code nào xin Diễn đàn hướng dẫn thêm.
Có 1 vấn đề phát sinh ở code 1 là: khi chạy các lần tiếp theo thì border không tự co giãn. Mặt dù đã thêm câu lệnh = False vào đầu thủ tục.
Mình xin Diễn đàn giúp là:
- Chạy code thì Xóa border, xử lý dữ liệu xong và dán KQ thì thực hiện kẻ border+thêm 1 dòng.
Mong Diễn đàn hổ trợ.
Cảm ơn các Anh, Chị nhiều nhé!
 
Các bạn giúp mình ở code 1 nhé.
Mình đã thêm câu lệnh này sau câu lệnh = True.
ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Đã giải quyết được 1 phần, còn cái border thêm 1 dòng thì không giải quyết được.
Rất mong sự hổ trợ của các bạn.
Mình chân thành cảm ơn nhiều!
 
Tuan.DNa đã viết:
Các bạn giúp mình ở code 1 nhé.
Mình đã thêm câu lệnh này sau câu lệnh = True.
ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Đã giải quyết được 1 phần, còn cái border thêm 1 dòng thì không giải quyết được.
Rất mong sự hổ trợ của các bạn.
Mình chân thành cảm ơn nhiều!
Nhấp chuột vào đây để mở rộng...
Không có file và code nên đoán mò"
1/ Thử tham khảo:
Sub Abc()
Dim LrD&
Dim....
LrD=Sh.Range("D65536").End(3).Row ' dòng cuối trước khi gán dữ liệu xuống sheet

...Code lấy dữ liệu và gán xuống sheet
(ví dụ lấy được t dòng)
If t then
ws.Range("A4:H" & LrD).Clearcontents ' Xóa bỏ dữ liệu cũ
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone 'định dạng vùng dữ liệu cũ (không đường kẻ)
Ws.Range("A"&LrD+1).resize(t,8)=mảng kết quả ' gán mảng kết quả xuống sheet
Ws.Range("A4:H" & LrD+t).Borders.LineStyle=1 ' định dạng lại vùng kết quả ( có đường kẻ khung)
xem sao.
2/ Nên khai báo
Dim Rng as Range, Rng1 as Range, Rng2 as Range
Thay cho
Dim Rng, Rng1, Rng2 as Range.
Khi báo như này thì VBA chỉ nhận Rng2 là range còn Rng, Rng1 là varial cho nên rất có thể kết quả tính toán sẽ sai hoặc bị lỗi. Không có file nên không thử được.
 
HUONGHCKT đã viết:
Không có file và code nên đoán mò"
1/ Thử tham khảo:
Sub Abc()
Dim LrD&
Dim....
LrD=Sh.Range("D65536").End(3).Row ' dòng cuối trước khi gán dữ liệu xuống sheet

...Code lấy dữ liệu và gán xuống sheet
(ví dụ lấy được t dòng)
If t then
ws.Range("A4:H" & LrD).Clearcontents ' Xóa bỏ dữ liệu cũ
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone 'định dạng vùng dữ liệu cũ (không đường kẻ)
Ws.Range("A"&LrD+1).resize(t,8)=mảng kết quả ' gán mảng kết quả xuống sheet
Ws.Range("A4:H" & LrD+t).Borders.LineStyle=1 ' định dạng lại vùng kết quả ( có đường kẻ khung)
xem sao.
2/ Nên khai báo
Dim Rng as Range, Rng1 as Range, Rng2 as Range
Thay cho
Dim Rng, Rng1, Rng2 as Range.
Khi báo như này thì VBA chỉ nhận Rng2 là range còn Rng, Rng1 là varial cho nên rất có thể kết quả tính toán sẽ sai hoặc bị lỗi. Không có file nên không thử được.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhé.
 
HUONGHCKT đã viết:
Không có file và code nên đoán mò"
1/ Thử tham khảo:
Sub Abc()
Dim LrD&
Dim....
LrD=Sh.Range("D65536").End(3).Row ' dòng cuối trước khi gán dữ liệu xuống sheet

...Code lấy dữ liệu và gán xuống sheet
(ví dụ lấy được t dòng)
If t then
ws.Range("A4:H" & LrD).Clearcontents ' Xóa bỏ dữ liệu cũ
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone 'định dạng vùng dữ liệu cũ (không đường kẻ)
Ws.Range("A"&LrD+1).resize(t,8)=mảng kết quả ' gán mảng kết quả xuống sheet
Ws.Range("A4:H" & LrD+t).Borders.LineStyle=1 ' định dạng lại vùng kết quả ( có đường kẻ khung)
xem sao.
2/ Nên khai báo
Dim Rng as Range, Rng1 as Range, Rng2 as Range
Thay cho
Dim Rng, Rng1, Rng2 as Range.
Khi báo như này thì VBA chỉ nhận Rng2 là range còn Rng, Rng1 là varial cho nên rất có thể kết quả tính toán sẽ sai hoặc bị lỗi. Không có file nên không thử được.
Nhấp chuột vào đây để mở rộng...
Dear @HUONGHCKT
Code bạn đề xuất, như code mình đã đề cập ở bài 29+30.
Nhưng khi Run thì kẻ border không tự co giãn. Nghĩa là thủ tục con: tính toán SumProduct, lọc dữ liệu và trích xuất được 10 dòng. Chạy Run lần 2 và trích lọc được 5 dòng, thì border không co giãn còn 5 mà vẫn y nguyên border cho 10 dòng.
Nếu để câu lệnh:
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Ngay sau câu lệnh
ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
Thì vấn đề tự co giãn border được giải quyết.
Nhưng phát sinh vấn đề khác:
Bấm Run lần 1 thì border không tạo ở dòng cuối +1(mà tạo xác dòng dữ liệu cuối). Bấm Run lần 2 thì lại được.
Mình không hiểu vấn đề lỗi nằm ở đâu nữa.
Bạn cho mình hỏi: trong câu lệnh trên, =True và =1 là giống hay khác nhau.
Chúc bạn buổi tối vui vẽ nhé. Cảm ơn nhiều!
Vấn đề khai báo Rng mình xin học hỏi và rút kinh nghiệm
 
Tuan.DNa đã viết:
Dear @HUONGHCKT
Code bạn đề xuất, như code mình đã đề cập ở bài 29+30.
Nhưng khi Run thì kẻ border không tự co giãn. Nghĩa là thủ tục con: tính toán SumProduct, lọc dữ liệu và trích xuất được 10 dòng. Chạy Run lần 2 và trích lọc được 5 dòng, thì border không co giãn còn 5 mà vẫn y nguyên border cho 10 dòng.
Nếu để câu lệnh:
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Ngay sau câu lệnh
ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
Thì vấn đề tự co giãn border được giải quyết.
Nhưng phát sinh vấn đề khác:
Bấm Run lần 1 thì border không tạo ở dòng cuối +1(mà tạo xác dòng dữ liệu cuối). Bấm Run lần 2 thì lại được.
Mình không hiểu vấn đề lỗi nằm ở đâu nữa.
Bạn cho mình hỏi: trong câu lệnh trên, =True và =1 là giống hay khác nhau.
Chúc bạn buổi tối vui vẽ nhé. Cảm ơn nhiều!
Vấn đề khai báo Rng mình xin học hỏi và rút kinh nghiệm
Nhấp chuột vào đây để mở rộng...
Nói chung là không có file và có code thì trong ai vạch hướng cho bạn cũng chỉ là "thầy bói xem voi" thôi.
Xem lại từ đầu, tôi thấy Việc tạo file giả định, hoặc có code của bạn (chạy chưa đúng ý định) là 1 điều hết sức xa xỉ đối với bạn. Thế cho nên bạn muốn biến người hộ trợ bạn thành thày bói, hay là kẻ đoán mò thật sao?
 
Tuan.DNa đã viết:
Dear @HUONGHCKT
Code bạn đề xuất, như code mình đã đề cập ở bài 29+30.
Nhưng khi Run thì kẻ border không tự co giãn. Nghĩa là thủ tục con: tính toán SumProduct, lọc dữ liệu và trích xuất được 10 dòng. Chạy Run lần 2 và trích lọc được 5 dòng, thì border không co giãn còn 5 mà vẫn y nguyên border cho 10 dòng.
Nếu để câu lệnh:
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone
Ngay sau câu lệnh
ws.Range("A4:H" & LrD+1).Borders.LineStyle = True
Thì vấn đề tự co giãn border được giải quyết.
Nhưng phát sinh vấn đề khác:
Bấm Run lần 1 thì border không tạo ở dòng cuối +1(mà tạo xác dòng dữ liệu cuối). Bấm Run lần 2 thì lại được.
Mình không hiểu vấn đề lỗi nằm ở đâu nữa.
Bạn cho mình hỏi: trong câu lệnh trên, =True và =1 là giống hay khác nhau.
Chúc bạn buổi tối vui vẽ nhé. Cảm ơn nhiều!
Vấn đề khai báo Rng mình xin học hỏi và rút kinh nghiệm
Nhấp chuột vào đây để mở rộng...
Theo tôi
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=xlNone hoặc =0.
Và
Ws.Range("A4:H" & LrD+1).Borders.LineStyle=True hoặc =1.
Là như nhau
Không biết các cao thủ khác thì như thế nào!
 
Lần chỉnh sửa cuối:
Toàn bộ code mình viết cho Sheet BC:
Sub Loc_BC()
Dim Lr, LrD, Lr_N, Lr_X, Lr_T As Long
Lr = Sheets("BC").Cells(Rows.Count, 4).End(xlUp).Row
LrD = Sheets("BC").Range("C65536").End(xlUp).Row

Lr_N = Sheets("NHAP").Cells(Rows.Count, 4).End(xlUp).Row
Lr_X = Sheets("XUAT").Cells(Rows.Count, 4).End(xlUp).Row
Lr_T = Sheets("TON").Cells(Rows.Count, 4).End(xlUp).Row
Set Target = Sheets("BC").Range("C6")
' -----------------------------------
If Target.Value = "N" Then
Sheets("BC").Range("A8:H" & Lr).ClearContents
Sheets("NHAP").Range("A2:H" & Lr_N).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BC").Range("A5:E6"), CopyToRange:=Sheets("BC").Range("A7:H7"), Unique:=False
' --------------------------
End If
' -----------------------------------
If Target.Value = "X" Then
Sheets("BC").Range("A8:H" & Lr).ClearContents
Sheets("XUAT").Range("A2:H" & Lr_N).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BC").Range("A5:E6"), CopyToRange:=Sheets("BC").Range("A7:H7"), Unique:=False

End If
' -----------------------------------
If Target.Value = "T" Then
Sheets("BC").Range("A8:H" & Lr).ClearContents
Sheets("TON").Range("A5:H" & Lr_N).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("BC").Range("A5:E6"), CopyToRange:=Sheets("BC").Range("A7:H7"), Unique:=False

End If
' -----------------------------------
If Target.Value = "" Then
' (Thong bao ko chon chuc nang loc)
MsgBox "De nghi chon bao cao N, X, T...! "
Exit Sub
End If
' -----------------------------------
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = True
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = xlNone

End Sub
---------------
Trường hợp để 2 câu lệnh gần nhau:
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = True
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = xlNone
Lọc BC như hình (1)

Trường hợp để 1 câu lệnh đầu thủ tục và 1 câu lệnh cuối thủ tục:
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = xlNone
' ,...................
thủ tục con
' ....................
Sheets("BC").Range("A8:H" & LrD + 1).Borders.LineStyle = True
Lọc BC như hình (2)

Các bạn xem giúp mình nhé.
 

File đính kèm

  • 1.jpg
    1.jpg
    139.7 KB · Đọc: 10
  • 2.jpg
    2.jpg
    107.4 KB · Đọc: 10
Các bạn fix giùm lỗi ở code trên giúp mình nhé.
Cảm ơn sự giúp đở của các bạn rất rất nhiều nha
 
Cách kẻ dòng thì mình thấy đơn giản nhất là copy paste định dạng là ổn nhất
 
Tuan.DNa đã viết:
Vậy bạn cho mình hướng dẫn code được không. Kiểu copy, paste theo định dạng. Mong bạn hổ trợ giúp mình nhé!
Nhấp chuột vào đây để mở rộng...
Có ji mai nha bạn. On bằng đt nên ko gửi đc. Code mình thế này. Khi bạn có dữ liệu ở dòng cuối ( bạn có thể đặt 1 cộ nào đó để kiểm tra dòng cuối là dòng nào sau đó copy định dạng dòng bên trên pase xuống dòng cuối đó. Cứ khi nào dòng cuối được hình thành là kế tiếp pase định dạng. Ko có dòng cuối thì ko đingj dạng
Bài đã được tự động gộp:

Bác gửi file lên đi mai rãnh mình làm thử xem
 
ngochienbmt đã viết:
Có ji mai nha bạn. On bằng đt nên ko gửi đc. Code mình thế này. Khi bạn có dữ liệu ở dòng cuối ( bạn có thể đặt 1 cộ nào đó để kiểm tra dòng cuối là dòng nào sau đó copy định dạng dòng bên trên pase xuống dòng cuối đó. Cứ khi nào dòng cuối được hình thành là kế tiếp pase định dạng. Ko có dòng cuối thì ko đingj dạng
Bài đã được tự động gộp:

Bác gửi file lên đi mai rãnh mình làm thử xem
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn. Mình mong chờ code nhé
 
Hướng fix lỗi như thế nào các bạn.
@HUONGHCKT giúp mình được không zậy ta!
 
HUONGHCKT đã viết:
Nói chung là không có file và có code thì trong ai vạch hướng cho bạn cũng chỉ là "thầy bói xem voi" thôi.
Xem lại từ đầu, tôi thấy Việc tạo file giả định, hoặc có code của bạn (chạy chưa đúng ý định) là 1 điều hết sức xa xỉ đối với bạn. Thế cho nên bạn muốn biến người hộ trợ bạn thành thày bói, hay là kẻ đoán mò thật sao?
Nhấp chuột vào đây để mở rộng...

Tuan.DNa đã viết:
Hướng fix lỗi như thế nào các bạn.
@HUONGHCKT giúp mình được không zậy ta!
Nhấp chuột vào đây để mở rộng...
Không biết bạn đã đọc bài này chưa?
 
Tuan.DNa đã viết:
Ok bạn. Mình sẽ gửi file demo lên, hiện mình đi chơi rồi. Mai mình sẽ post
Nhấp chuột vào đây để mở rộng...
Đó là mình đề xuất với bạn để tăng khả năng có người giúp bạn thôi. Chứ việc là việc của bạn. Ai có nhã hứng thì người đó giúp bạn. Chứ thấy có người hỏi và cố gắng giúp bạn. Mà thấy bạn trả lời thõng là bạn hiện đang đi chơi. Kiểu như là việc giúp là người giúp phải giúp ấy.
 
BuiQuangThuan đã viết:
Đó là mình đề xuất với bạn để tăng khả năng có người giúp bạn thôi. Chứ việc là việc của bạn. Ai có nhã hứng thì người đó giúp bạn. Chứ thấy có người hỏi và cố gắng giúp bạn. Mà thấy bạn trả lời thõng là bạn hiện đang đi chơi. Kiểu như là việc giúp là người giúp phải giúp ấy.
Nhấp chuột vào đây để mở rộng...
Bây giờ bạn mới nhận ra chứ mình thì dạt ra xa lắm rồi.
 
BuiQuangThuan đã viết:
Đó là mình đề xuất với bạn để tăng khả năng có người giúp bạn thôi. Chứ việc là việc của bạn. Ai có nhã hứng thì người đó giúp bạn. Chứ thấy có người hỏi và cố gắng giúp bạn. Mà thấy bạn trả lời thõng là bạn hiện đang đi chơi. Kiểu như là việc giúp là người giúp phải giúp ấy.
Nhấp chuột vào đây để mở rộng...
Bạn nói vậy thì oan cho mình rồi. Code thì mình cũng đã gửi, file dính đến nhiều sheet, nhiều file liên kết. Nên mình không post file là vậy.
Vấn đề lỗi chổ nào mình cũng đã nêu rõ. Code mình cũng đã gửi. Và nhờ fix.
Còn vấn đề bạn không muốn giúp thì thôi vậy. Mình xin cảm ơn.
Chưa chắc bạn và @Hoàng Tuấn 868 giỏi, nhưng với cách suy nghỉ đó thì đồ bỏ.
Bạn @Hoàng Tuấn 868 có vẻ hay bắt bẻ bạn chẳng hơn ai cả. Giúp được thì giúp không giúp được thì next, tưởng đâu mình giỏi. Vãi!, giỏi là giúp được người khác và loan tỏa kiến thức của mình cho người thua bạn, mới gọi là giỏi. Đừng để bị xem thường khi ôm một mớ kién thức mà giử khư khư. Ok
 
Lần chỉnh sửa cuối:
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

T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu (7 người xem)
Trả lời
0
Đọc
4
tiendu02
T
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. (2 người xem)
Trả lời
2
Đọc
35
firstbood
F
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
438
Đọc
57K
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 (1 người xem)
Trả lời
17
Đọc
648
LOGANWover
L
H
Đánh số thự theo lượt
Trả lời
5
Đọc
101
hongminh_0306
H
D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL
Trả lời
2
Đọc
154
danhpheo
D
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên
    • Cảm ơn
Trả lời
2
Đọc
156
phuongnam366377
phuongnam366377
A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show
Trả lời
2
Đọc
114
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
173
truc.duong87
T
H
Tự động cập nhật dữ liệu từ 2 file word
Trả lời
1
Đọc
123
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
311
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter (1 người xem)
Trả lời
8
Đọc
172
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
414
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
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
9K
Hoale85
H
Nam168
Không mở được file excel (1 người xem)
Trả lời
2
Đọc
107
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
125
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
Trả lời
6
Đọc
328
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