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

[nguyenquan]

Đ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

 

[ndu96081631]

Đ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

Tôi vẫn không hiểu đoạn này:

[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]

 

[nguyenquan]

Đâ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.

 

[ndu96081631]

Đâ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.

Vầy xem:

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

 

[nguyenquan]

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ẽ.

 

[hoangtuaotrang_hp_vn]

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ư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

 

[leorio.1989]

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 ạ.

 

[VetMini]

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?

 

[leorio.1989]

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?

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.

 

[Maika8008]

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 ạ.

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:

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

 

[leorio.1989]

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:

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

Đội ơn bác ạ. Chính nó đây rồi

 

[VetMini]

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:

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

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

 

[Maika8008]

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

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.

 

[batman1]

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.

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.

 

[Maika8008]

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.

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ơ.

 

[batman1]

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ơ.

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.