Copy vùng dữ liệu theo lựa chọn từ ComboBox

[Võ Thiếu Gia]

Dear các anh/chị,
Tình hình là mình cũng chưa rành lắm về VBA. Nhưng do nhu cầu công việc lặp đi lặp lại, nên nhờ các anh/chị tạo giúp mình đoạn code như trong fike đính kèm.

Thanks & Best Regards
VTG

 

[mhung12005]

Code của bạn... buồn cười quá nhỉ
???
Bạn thay ComboBox bằng Dropdown rồi... For... Next gì gì đó... Tóm lại code viết quá thừa
Code của bạn có thể sửa thành:

Sub test()
  Dim k As Long
  With Sheet1.Range("A4:AB10000")
    k = .Parent.DropDowns(Application.Caller).Value
    .Resize(9, .Columns.Count - 2).Offset((k - 1) * 10, 2).Copy
  End With
End Sub

-----------------
Không phải em thay cái ComboBox bằng Dropdown đâu sư phụ. Đó là nguyên bản file đinh kèm của tác giả ở bài #1.
Em chỉ cố gắng làm sao cho ra kết quả tác giả mong muốn thôi.

Code của em đối với sư phụ có thể là "buồn cười quá", nhưng với em thì không buồn cười lắm vì dù sao nó vẫn ra kết quả. Hơn nữa cũng nhờ nó mà em học thêm đc thuộc tính Dropdown của sư phụ.

P/S: Chẳng hiểu sao em test thử code của sư phụ mà nó cứ báo lỗi: Unable to get the Dropdowns property of the Worksheet class. Hình như Excel đòi kích hoạt cái gì đó thì phải. Cái này em mù tịt, sư phụ chỉ giúp em với.

 

[Võ Thiếu Gia]

Quên mất cái vụ nén lại...hihi.
Nhờ các anh/chị chỉ giúp mình với

 

[ndu96081631]

Quên mất cái vụ nén lại...hihi.
Nhờ các anh/chị chỉ giúp mình với

Cái List trong ComboBox ở đâu rồi? Bạn buồn cười thật đó!
----------
Mà thôi, ngay từ đâu tôi định hỏi mà cứ quên:
- Tại sao bạn cần copy?
- Copy là để paste vào nơi nào đó chăng?
- Vậy sao không viết code để làm luôn (copy và paste đến đích)
Ai lại viết code nữa vời thế này?

 

[Võ Thiếu Gia]

Không biết nữa anh NDU,
Mình chép nguyên cái code của anh bỏ vô mà...hic

 

[Võ Thiếu Gia]

Cái List trong ComboBox ở đâu rồi? Bạn buồn cười thật đó!
----------
Mà thôi, ngay từ đâu tôi định hỏi mà cứ quên:
- Tại sao bạn cần copy?
- Copy là để paste vào nơi nào đó chăng?
- Vậy sao không viết code để làm luôn (copy và paste đến đích)
Ai lại viết code nữa vời thế này?

Hihi, Chỉ là cần đến copy thôi anh NDU. Còn past là mình past qua file khác anh à

 

[ndu96081631]

Hihi, Chỉ là cần đến copy thôi anh NDU. Còn past là mình past qua file khác anh à

Paste ra file nào cũng được, sao bạn không code 1 lần luôn? Tức copy và paste
---------------

Không biết nữa anh NDU,

File là của bạn. Bạn không biết thì AI BIẾT
Thôi, nghỉ chơi!

 

[Võ Thiếu Gia]

Paste ra file nào cũng được, sao bạn không code 1 lần luôn? Tức copy và paste
---------------

File là của bạn. Bạn không biết thì AI BIẾT
Thôi, nghỉ chơi!

Anh giúp giúp mình đi. Còn cái file để past vào do nó hay thay đổi, và mỗi chu kỳ lại khác nhau. Nên mình chỉ cần đến copy thôi anh à.

 

[nhapmon]

Paste ra file nào cũng được, sao bạn không code 1 lần luôn? Tức copy và paste
---------------

File là của bạn. Bạn không biết thì AI BIẾT
Thôi, nghỉ chơi!

thôi anh giúp bạn ấy đi.................
cái combobx list đó là do tôi tạo ra, tại vì lúc đâu bạn ấy tạo một cái list phụ làm source cho dropdown.
tôi thấy vậy mất công quá nên xoá đi cái list phụ đó.........vào tạo lại combobox.............chắc vì vậy bạn ấy ko biết

 

[ndu96081631]

thôi anh giúp bạn ấy đi.................
cái combobx list đó là do tôi tạo ra, tại vì lúc đâu bạn ấy tạo một cái list phụ làm source cho dropdown.
tôi thấy vậy mất công quá nên xoá đi cái list phụ đó.........vào tạo lại combobox.............chắc vì vậy bạn ấy ko biết

Mai sẽ tiếp!
Ẹc... Ẹc...

 

[ndu96081631]

Tiếp tục cho bạn đây!
1> Code chuyển đổi dữ liệu thành mảng (trong Module)

Function Convert2Array(ByVal CustomFormat As String, ByVal IgnoreBlanks As Boolean, ParamArray arrays())
  Dim aTmp, arr(), Item, tmp As String
  Dim i As Long, n As Long
  On Error Resume Next
  For i = LBound(arrays) To UBound(arrays)
    aTmp = arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      tmp = IIf(TypeName(Item) = "Error", "", Trim(CStr(Item)))
      If IgnoreBlanks = False Or Len(tmp) Then
        n = n + 1
        ReDim Preserve arr(1 To n)
        If Len(CustomFormat) Then
          arr(n) = Format(tmp, CustomFormat)
        Else
          arr(n) = tmp
        End If
      End If
    Next
  Next
  If n Then Convert2Array = arr
End Function

2> Nạp list cho ComboBox (trong Sheet1)

Private Sub ComboBox1_DropButtonClick()
  Dim arrays, arr
  On Error Resume Next
  arrays = Sheet1.Range("A4:A10000")
  arr = Convert2Array("dd/mm", True, arrays)
  Sheet1.ComboBox1.List() = arr
End Sub

3> Code copy dữ liệu khi chọn ComboBox

Private Sub ComboBox1_Click()
  Dim strDate As String, rFind As Range, rCopy As Range
  On Error Resume Next
  strDate = ComboBox1.Value
  With Range("A2:AB10000")
    Set rFind = .Resize(, 1).Find(strDate, , xlValues, xlWhole)
    If Not rFind Is Nothing Then
      Set rCopy = Intersect(.Cells, .Offset(, 2), rFind.EntireRow)
      Set rCopy = rCopy.Resize(rFind.MergeArea.Rows.Count)
      rCopy.Copy
    End If
  End With
End Sub

Với code này, mọi thay đổi ngày tháng tại cột A sẽ lập tức được cập nhật vào ComboBox
Xem file

 

[Võ Thiếu Gia]

Tiếp tục cho bạn đây!
1> Code chuyển đổi dữ liệu thành mảng (trong Module)

Function Convert2Array(ByVal CustomFormat As String, ByVal IgnoreBlanks As Boolean, ParamArray arrays())
  Dim aTmp, arr(), Item, tmp As String
  Dim i As Long, n As Long
  On Error Resume Next
  For i = LBound(arrays) To UBound(arrays)
    aTmp = arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      tmp = IIf(TypeName(Item) = "Error", "", Trim(CStr(Item)))
      If IgnoreBlanks = False Or Len(tmp) Then
        n = n + 1
        ReDim Preserve arr(1 To n)
        If Len(CustomFormat) Then
          arr(n) = Format(tmp, CustomFormat)
        Else
          arr(n) = tmp
        End If
      End If
    Next
  Next
  If n Then Convert2Array = arr
End Function

2> Nạp list cho ComboBox (trong Sheet1)

Private Sub ComboBox1_DropButtonClick()
  Dim arrays, arr
  On Error Resume Next
  arrays = Sheet1.Range("A4:A10000")
  arr = Convert2Array("dd/mm", True, arrays)
  Sheet1.ComboBox1.List() = arr
End Sub

3> Code copy dữ liệu khi chọn ComboBox

Private Sub ComboBox1_Click()
  Dim strDate As String, rFind As Range, rCopy As Range
  On Error Resume Next
  strDate = ComboBox1.Value
  With Range("A2:AB10000")
    Set rFind = .Resize(, 1).Find(strDate, , xlValues, xlWhole)
    If Not rFind Is Nothing Then
      Set rCopy = Intersect(.Cells, .Offset(, 2), rFind.EntireRow)
      Set rCopy = rCopy.Resize(rFind.MergeArea.Rows.Count)
      rCopy.Copy
    End If
  End With
End Sub

Với code này, mọi thay đổi ngày tháng tại cột A sẽ lập tức được cập nhật vào ComboBox
Xem file

Thanks anh NDU rất rất nhiều. Tuy nhiên, mình có thể làm thêm code để đến khi mình chọn ở ở dòng nào thì con trỏ chuột chạy theo đến dòng đó không anh.
Ví dụ: Khi mình chọn ngày 10/09 thì con trỏ chuột sẽ nằm ở cell A14:A22 không anh.

 

[ndu96081631]

Thanks anh NDU rất rất nhiều. Tuy nhiên, mình có thể làm thêm code để đến khi mình chọn ở ở dòng nào thì con trỏ chuột chạy theo đến dòng đó không anh.
Ví dụ: Khi mình chọn ngày 10/09 thì con trỏ chuột sẽ nằm ở cell A14:A22 không anh.

Quá dễ:

Private Sub ComboBox1_Click()
  Dim strDate As String, rFind As Range, rCopy As Range
  On Error Resume Next
  strDate = ComboBox1.Value
  With Range("A2:AB10000")
    Set rFind = .Resize(, 1).Find(strDate, , xlValues, xlWhole)
    If Not rFind Is Nothing Then
      Set rCopy = Intersect(.Cells, .Offset(, 2), rFind.EntireRow)
      Set rCopy = rCopy.Resize(rFind.MergeArea.Rows.Count)
      [COLOR=#ff0000][B]Application.Goto rCopy[/B][/COLOR]
      rCopy.Copy
    End If
  End With
End Sub

Chổ màu đỏ là chổ thêm vào

 

[Võ Thiếu Gia]

Dear anh NDU,
Không hiểu sao code của anh khi bỏ vào file gốc của em lại không chạy được.
Em có đổi tên Sheét thành đúng tên sheet "Scorecacrd" trong file gốc.
Anh xem giúp em nhé.
Thanks

 

[Let'GâuGâu]

Dear anh NDU,
Không hiểu sao code của anh khi bỏ vào file gốc của em lại không chạy được.
Em có đổi tên Sheét thành đúng tên sheet "Scorecacrd" trong file gốc.
Anh xem giúp em nhé.
Thanks

hình như sửa lại như vậy được nè

Private Sub ComboBox1_DropButtonClick()
Dim arrays, arr
On Error Resume Next
arrays = Sheets("Scorecard").Range("A4:A10000") ' hoặc sheet7
arr = Convert2Array("dd/mm", True, arrays)
Sheets("Scorecard").ComboBox1.List() = arr ' hoặc sheet7
End Sub

chắc là bạn nên trang bị cho một một ít kiến thức về vba, nếu muốn sử dụng nó

 

[Võ Thiếu Gia]

hình như sửa lại như vậy được nè

Private Sub ComboBox1_DropButtonClick()
Dim arrays, arr
On Error Resume Next
arrays = Sheets("Scorecard").Range("A4:A10000") ' hoặc sheet7
arr = Convert2Array("dd/mm", True, arrays)
Sheets("Scorecard").ComboBox1.List() = arr ' hoặc sheet7
End Sub

chắc là bạn nên trang bị cho một một ít kiến thức về vba, nếu muốn sử dụng nó

Thanks Let's GâuGâu nhiều.
Chắc là phải trang bị vấn đề này thật rồi. Kém cỏi quá...hichic