Sử dụng 2 code Private Sub Worksheet_Change(ByVal Target As Range) cho 1 sheet (1 người xem)

Elx 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)
N

nguyenquan

Thành viên mới
Tham gia
3/6/08
Bài viết
4
Được thích
0
Đoạn code sau : khi nhập ở cột A thì dữ liệu đồng thời nhập vào ô A1 của sheet 2. Tôi muốn đoạn code mở rộng thêm khi nhập ở cột B thì dữ liệu đồng thời nhập vào ô A2 của sheet 2 thì phải chỉnh như thế nào, nếu sử dụng 2 code Private Sub Worksheet_Change(ByVal Target As Range) cho 1 sheet thì không được. Xin các bậc tiền bối hướng dẫn giúp. Cảm ơn


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range
Set rng = Intersect(Target, Range("a2:a" & Rows.Count))
If rng Is Nothing Then Exit Sub
For Each r In rng
If Not IsEmpty(r.Value) Then
r.Copy Destination:=Sheets("sheet2").Range("a1")
End If
Next
Set rng = Nothing
End Sub
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
nguyenquan đã viết:
Đoạn code sau : khi nhập ở cột A thì dữ liệu đồng thời nhập vào ô A1 của sheet 2. Tôi muốn đoạn code mở rộng thêm khi nhập ở cột B thì dữ liệu đồng thời nhập vào ô A2 của sheet 2 thì phải chỉnh như thế nào, nếu sử dụng 2 code Private Sub Worksheet_Change(ByVal Target As Range) cho 1 sheet thì không được. Xin các bậc tiền bối hướng dẫn giúp. Cảm ơn


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range
Set rng = Intersect(Target, Range("a2:a" & Rows.Count))
If rng Is Nothing Then Exit Sub
For Each r In rng
If Not IsEmpty(r.Value) Then
r.Copy Destination:=Sheets("sheet2").Range("a1")
End If
Next
Set rng = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Tôi vẫn không hiểu đoạn này:

Mã: 
[COLOR=#333333][FONT=Verdana]For Each r In rng[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]If Not IsEmpty(r.Value) Then[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]r.Copy Destination:=Sheets("sheet2").Range("a1")[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End If[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Next
Tại sao phải For... Next rồi cuối cùng tất cả đều copy/paste vào 1 cell A1 của Sheet2? ---> Vậy thì For... Next làm gì?
[/FONT][/COLOR]
 
Upvote 0
Đây là đoạn code sưu tầm được để áp dụng vào file, bây giờ cần mở rộng như yêu cầu ở trên nhưng không biết làm thế nào. do không biết về VBA nên nhờ các bậc tiền bối giúp, hiện giờ cũng đang mày mò tìm hiểu về VBA. Cảm ơn mọi người.
 
Upvote 0
nguyenquan đã viết:
Đây là đoạn code sưu tầm được để áp dụng vào file, bây giờ cần mở rộng như yêu cầu ở trên nhưng không biết làm thế nào. do không biết về VBA nên nhờ các bậc tiền bối giúp, hiện giờ cũng đang mày mò tìm hiểu về VBA. Cảm ơn mọi người.
Nhấp chuột vào đây để mở rộng...

Vầy xem:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count = 1 Then
    If Not IsEmpty(Target.Value) Then
      If Not Intersect(Range("A2:A1000"), Target) Is Nothing Then
        Sheets("sheet2").Range("A1").Value = Target.Value
      ElseIf Not Intersect(Range("B2:B1000"), Target) Is Nothing Then
        Sheets("sheet2").Range("B1").Value = Target.Value
      End If
    End If
  End If
End Sub
 
Upvote 0
Cảm ơn ndu96081631 nhiều, mình đã áp dụng được rồi, mình phải học VBA thôi, cảm ơn sự tận tình của các thành viên của diễn đàn giaiphapexcel. Chúc mọi người sức khoẽ.
 
Upvote 0
anh @ ndu96081631 ơi, em đang có code này:
Private priArray
Private priIsFocus As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 And Target.Row > 6 And Target.Column = 2 Then
Dim e As Long
Dim sh As Worksheet
Set sh = Sheets("List-code")
If Not IsArray(priArray) Then
e = sh.Range("B" & Rows.Count).End(xlUp).Row
priArray = sh.Range("B6:C" & e).Value2
End If
Call HienComboBox
Else
Call AnComboBox
End If
End Sub

Private Sub ComboBox1_Change()
If priIsFocus Then Exit Sub
If ComboBox1.MatchFound Then
ActiveCell.Value = ComboBox1.Text
ActiveCell.Offset(, 1).Value = ComboBox1.Column(1)
Else
ActiveCell.Value = ""
ActiveCell.Offset(, 1).Value = ""
End If
End Sub

Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Select Case KeyCode
Case 16, 17, 37 To 40
Case 9
ActiveCell.Offset(, 1).Activate
Case 13
ActiveCell.Offset(1).Activate
Case Else
If IsArray(priArray) Then
Dim strValue As String
strValue = LCase(ComboBox1.Text)
ComboBox1.ListRows = 20
If Trim(strValue) > "" Then
Dim ArrFilter, GetRow()
Dim c As Long, i As Long, n As Long, r As Long
For r = 1 To UBound(priArray, 1)
If LCase(priArray(r, 1)) Like "*" & strValue & "*" Then
n = n + 1
ReDim Preserve GetRow(1 To n)
GetRow(n) = r
End If
Next
If n Then
Dim u As Byte
u = UBound(priArray, 2)
ReDim ArrFilter(1 To n, 1 To u)
For r = 1 To n
For c = 1 To u
ArrFilter(r, c) = priArray(GetRow(r), c)
Next
Next
ComboBox1.List = ArrFilter
Else
ComboBox1.Clear
ComboBox1.ListRows = 0
End If
ComboBox1.DropDown
Else
If ComboBox1.ListCount <> UBound(priArray) Then
ComboBox1.List = priArray
ComboBox1.DropDown
End If
End If
End If
End Select
End Sub

Private Sub HienComboBox()
priIsFocus = True
With ComboBox1
.Visible = False
.Visible = True
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.Width = ActiveCell.Width
.ListWidth = ActiveCell.Resize(, 3).Width + 12
.ColumnWidths = .Width - 4 & "." & ActiveCell.Offset(, 1).Width
.Height = ActiveCell.Height
.List = priArray
.Text = ActiveCell.Value
.Activate
.SelStart = 0
.SelLength = Len(.Text)
End With
priIsFocus = False
End Sub

Private Sub AnComboBox()
With ComboBox1
If .Visible Then
.Visible = False
End If
End With
End Sub
Nhấp chuột vào đây để mở rộng...



Nhưng muốn thêm code sau (trong cùng 1 sheet), phải làm như nào ạ:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 3 Or Target.Row < 5 Or Target.Count > 1 Then
Calendar1.Visible = False
Else
With Calendar1
.Left = Target.Left
.Top = Target.Top
.Visible = True
End With
End If
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Cùng 1 vấn đề, em có đoạn code ngắn mong các bác hợp nhất giúp:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B6:F10000")) Is Nothing Then
If Target.Count = 1 And Target <> "" Then
Unprotect "2022"
Target.Locked = True
Protect "2022"
End If
End If
End Sub
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("C6:C999"), Target) Is Nothing Then
If Range("C" & Target.Row).Value = "" Then
Range("J" & Target.Row).ClearContents
Else
Range("J" & Target.Row).Value = Now
End If
End If
End Sub


Tóm lại là em muốn khóa hết các cột chỉ định khi nhập xong dữ liệu, và ghi lại thời điểm nhập dữ liệu đó ở 1 cột khác (ở đây đang hiểu là cột J)

Đây là 2 đoạn code em sưu tầm được để giải bài toán trên nhưng vấn đề là khi kết hợp vào thì nó không nhận vì có 2 tầng Private Sub Worksheet_Change. Mong các bác hợp nhất giúp em ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
Hai vùng target của bạn không riêng biệt. Điển hình, ô C6 sẽ thoả mãn điều kiện cả hai subs.
Bạn cần suy nghĩ lại cho chính chắn.
Nếu vẫn giữ ý như vậy thì cũng cần cho biết: giải quyết bên nào trước?
 
Upvote 0
VetMini đã viết:
Hai vùng target của bạn không riêng biệt. Điển hình, ô C6 sẽ thoả mãn điều kiện cả hai subs.
Bạn cần suy nghĩ lại cho chính chắn.
Nếu vẫn giữ ý như vậy thì cũng cần cho biết: giải quyết bên nào trước?
Nhấp chuột vào đây để mở rộng...
Bác ơi đây là File của em, bác có thể giúp em tạo cái mã rằng khi em nhập liệu ở cột C thì khóa hết dữ liệu đã nhập trước đó và đồng thời ghi lại thời gian ngày giờ quét mã thực tế ở 1 cột bất kỳ được không ạ.

Đội ơn bác.
 

File đính kèm

Upvote 0
leorio.1989 đã viết:
Cùng 1 vấn đề, em có đoạn code ngắn mong các bác hợp nhất giúp:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B6:F10000")) Is Nothing Then
If Target.Count = 1 And Target <> "" Then
Unprotect "2022"
Target.Locked = True
Protect "2022"
End If
End If
End Sub
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("C6:C999"), Target) Is Nothing Then
If Range("C" & Target.Row).Value = "" Then
Range("J" & Target.Row).ClearContents
Else
Range("J" & Target.Row).Value = Now
End If
End If
End Sub


Tóm lại là em muốn khóa hết các cột chỉ định khi nhập xong dữ liệu, và ghi lại thời điểm nhập dữ liệu đó ở 1 cột khác (ở đây đang hiểu là cột J)

Đây là 2 đoạn code em sưu tầm được để giải bài toán trên nhưng vấn đề là khi kết hợp vào thì nó không nhận vì có 2 tầng Private Sub Worksheet_Change. Mong các bác hợp nhất giúp em ạ.
Nhấp chuột vào đây để mở rộng...
Không biết trạng thái của sheet trước khi chạy code thế nào nên tôi cứ đoán và tạm ra code như sau. Đúng thì tốt, sai nhận phản hồi làm lại:
Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B6:F10000")) Is Nothing Then
        If Target.Count = 1 And Target <> "" Then
            Unprotect "2022"
            Target.Locked = True
            Protect "2022"
        End If
        If Not Application.Intersect(Range("C6:C999"), Target) Is Nothing Then
            If Range("C" & Target.Row).Value = "" Then
                Range("J" & Target.Row).ClearContents
            Else
                Application.EnableEvents = False
                Unprotect "2022"
                Range("J" & Target.Row).Value = Now
                Protect "2022"
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub
 
Upvote 0
Maika8008 đã viết:
Không biết trạng thái của sheet trước khi chạy code thế nào nên tôi cứ đoán và tạm ra code như sau. Đúng thì tốt, sai nhận phản hồi làm lại:
Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B6:F10000")) Is Nothing Then
        If Target.Count = 1 And Target <> "" Then
            Unprotect "2022"
            Target.Locked = True
            Protect "2022"
        End If
        If Not Application.Intersect(Range("C6:C999"), Target) Is Nothing Then
            If Range("C" & Target.Row).Value = "" Then
                Range("J" & Target.Row).ClearContents
            Else
                Application.EnableEvents = False
                Unprotect "2022"
                Range("J" & Target.Row).Value = Now
                Protect "2022"
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Đội ơn bác ạ. Chính nó đây rồi
 
Upvote 0
Maika8008 đã viết:
Không biết trạng thái của sheet trước khi chạy code thế nào nên tôi cứ đoán và tạm ra code như sau. Đúng thì tốt, sai nhận phản hồi làm lại:
Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B6:F10000")) Is Nothing Then
        If Target.Count = 1 And Target <> "" Then
            Unprotect "2022"
            Target.Locked = True
            Protect "2022"
        End If
        If Not Application.Intersect(Range("C6:C999"), Target) Is Nothing Then
            If Range("C" & Target.Row).Value = "" Then
                Range("J" & Target.Row).ClearContents
            Else
                Application.EnableEvents = False
                Unprotect "2022"
                Range("J" & Target.Row).Value = Now
                Protect "2022"
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Code không hẳn là sai nhưng theo quy tắc phát triển phần mềm (software development) thì bạn làm không đúng.

Đúng phương pháp là đổi tên hai sub kia thành Change_1 và Change_2. Rồi dùng event như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tg As Range
Set tg = Target
Change_1 tg
Change_2 tg
End Sub
 
Upvote 0
VetMini đã viết:
Code không hẳn là sai nhưng theo quy tắc phát triển phần mềm (software development) thì bạn làm không đúng.

Đúng phương pháp là đổi tên hai sub kia thành Change_1 và Change_2. Rồi dùng event như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tg As Range
Set tg = Target
Change_1 tg
Change_2 tg
End Sub
Nhấp chuột vào đây để mở rộng...
Thực tình là không phải tôi làm không đúng mà là hồi nào đến giờ tôi không/chưa biết cách làm như bác. Chừ thì biết rồi đó bác.
 
Upvote 0
Maika8008 đã viết:
Thực tình là không phải tôi làm không đúng mà là hồi nào đến giờ tôi không/chưa biết cách làm như bác. Chừ thì biết rồi đó bác.
Nhấp chuột vào đây để mở rộng...
Tôi đoán mò thì không phải chủ thớt muốn hay cố tình viết 2 sub. Chẳng qua anh ta không biết viết gộp nên anh ta viết 2 sub rồi nhờ người khác gộp lại hộ. Tóm lại anh ta muốn có 1 sub thôi.

Cũng may là anh ta có 2 sub chứ nếu anh ta có 10 sub (mỗi sub cho Target - cell khác nhau) thì việc để 10 sub rồi 10 call không phải là ý hay. Rất khó theo dõi code, mà code rườm rà, code gộp có thể rất ngắn gọn. Vd. code cho 10 sub với Target = E1, E2, ..., E10 thì thay vì lặp lại 1 sub 10 lần thì chỉ 1 sub rồi xét Target tương quan với E1:E10. Code càng đơn giản thì càng ít cơ hội phạm lỗi khó tìm và ngớ ngẩn (nhiều khi viết không cẩn thận thì 10 sub không đồng bộ, sub này xung đột với sub kia), và dễ hiểu hơn.
 
Upvote 0
batman1 đã viết:
Tôi đoán mò thì không phải chủ thớt muốn hay cố tình viết 2 sub. Chẳng qua anh ta không biết viết gộp nên anh ta viết 2 sub rồi nhờ người khác gộp lại hộ. Tóm lại anh ta muốn có 1 sub thôi.

Cũng may là anh ta có 2 sub chứ nếu anh ta có 10 sub (mỗi sub cho Target - cell khác nhau) thì việc để 10 sub rồi 10 call không phải là ý hay. Rất khó theo dõi code, mà code rườm rà, code gộp có thể rất ngắn gọn. Vd. code cho 10 sub với Target = E1, E2, ..., E10 thì thay vì lặp lại 1 sub 10 lần thì chỉ 1 sub rồi xét Target tương quan với E1:E10. Code càng đơn giản thì càng ít cơ hội phạm lỗi khó tìm và ngớ ngẩn (nhiều khi viết không cẩn thận thì 10 sub không đồng bộ, sub này xung đột với sub kia), và dễ hiểu hơn.
Nhấp chuột vào đây để mở rộng...

Tôi thì nghĩ là chủ thớt có 2 sub hoạt động trên 2 Sheet khác nhau nhưng chừ muốn chỉ chạy trên 1 sheet thôi. Anh ta muốn gộp nhưng không gộp được vì đụng tới sự kiện của sheet thì không dễ cho 1 tay mơ.
 
Upvote 0
Maika8008 đã viết:
Tôi thì nghĩ là chủ thớt có 2 sub hoạt động trên 2 Sheet khác nhau nhưng chừ muốn chỉ chạy trên 1 sheet thôi. Anh ta muốn gộp nhưng không gộp được vì đụng tới sự kiện của sheet thì không dễ cho 1 tay mơ.
Nhấp chuột vào đây để mở rộng...
Tức là anh ta muốn viết 1 sub để có thể xóa 2 sub đã có, chứ không phải viết 1 sub mới để gọi 2 sub kia. Tôi hiểu là thế.

Còn ý tác giả thế nào thì chịu.
 
Upvote 0
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

H
Chia sẻ file in Phiếu điều tra PCGD (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
9
Đọc
317
vinh91@
V
thanhss
Nhờ tìm công thức tính tổng theo hàng có kèm dữ liệu Text (2 người xem)
Trả lời
6
Đọc
81
thanhss
thanhss
befaint
Chia sẻ tâm tư, xả nỗi lòng (10 người xem)
    • Thích
6 7 8
Trả lời
777
Đọc
72K
befaint
befaint
H
  • Question Question
Code Sổ Chi Tiết Tài Khoản (2 người xem)
Trả lời
4
Đọc
154
hieuvietmy2020
H
H
File excel bị lỗi không mở được (2 người xem)
Trả lời
6
Đọc
57
hiep204
H
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA (2 người xem)
    • Thích
Trả lời
10
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
A
  • Question Question
Sửa code VBA nhập liệu userform (2 người xem)
Trả lời
24
Đọc
991
ongke0711
ongke0711
SA_DQ
Copilot & bài thơ chia bánh do 'Hắn' sáng tác (2 người xem)
Trả lời
2
Đọc
69
SA_DQ
SA_DQ
HeSanbi
  • Đã giải quyết
WeatherXL - Ứng dụng lấy dữ liệu Thời tiết siêu nhanh (***Nguồn cấp FreeMeteo đã dừng cấp dữ liệu lịch sử) (3 người xem)
    • Thích
    • Yêu thích
Trả lời
90
Đọc
25K
dinhhoangcd13
D
T
GẤP: TÌM GIÁ THEO TỪNG KHÁCH (2 người xem)
Trả lời
7
Đọc
345
tulipviet
T
D
lấy thẻ kho từ sổ kho nên dùng hàm nào ah (2 người xem)
Trả lời
3
Đọc
90
dankedun
D
L
công thứ tìm giá trị giao hàng với cột (2 người xem)
Trả lời
13
Đọc
205
luongcongdua
L
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
4 5 6
Trả lời
552
Đọc
70K
ongke0711
ongke0711
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2. (3 người xem)
Trả lời
1
Đọc
112
thanthanhan
thanthanhan
SA_DQ
Tìm số chính phương trong 1 biểu thức cho trước (2 người xem)
    • Thích
    • Yêu thích
Trả lời
22
Đọc
401
dungpham01
D
T
TỈNH TỔNG TỪNG Ô THEO ĐIỀU KIỆN (2 người xem)
Trả lời
3
Đọc
135
thanthanhan
thanthanhan
8
Tính tổng điểm 3 môn theo tổ hợp xét tuyển (2 người xem)
Trả lời
3
Đọc
106
ptm0412
ptm0412
N
  • Question Question
Tool chia băng kết hợp bên ngành tôn (2 người xem)
Trả lời
0
Đọc
103
nguyenanhtruong2409
N
S
Chỉnh công thức tính tỷ lệ hoàn thành giúp mình với. (2 người xem)
Trả lời
8
Đọc
486
ptm0412
ptm0412
L
Tìm giải pháp trừ lùi nguyên liệu xuất nhập khẩu (2 người xem)
Trả lời
9
Đọc
319
luongcongdua
L
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