Làm thế nào thay đổi vùng chọn bằng VBA?

Liên hệ QC

phamduylong

-
Thành viên đã mất
Tham gia
30/12/06
Bài viết
918
Được thích
2,368
Nghề nghiệp
Giáo viên
Có vấn đề này thấy đơn giản mà tìm hoài không ra đáp số.
Có 2 vùng: A=Range("A1:G20"), B=Range("C3:D4")
Làm sao xác định được vùng C=A-C (là vùng A mà loại bỏ các ô trong vùng B) bằng VBA ?
 
Lần chỉnh sửa cuối:
Nếu vậy thì vùng chọn này vẫn.. thừa thầy à (nếu trong vùng có cell rổng)
Sao thầy không dùng 2 vòng lập: 1 duyệt qua Selection.SpecialCells(2) và 1 duyệt qua Selection.SpecialCells(3) ---> Như vậy ăn chắc vừa đủ, không thừa, không thiếu
Ý em rất hay. Nhưng mỗi trường hợp sẽ có 1 cách làm riêng. Quan trọng là mình biết phương pháp làm. Đúng là cộng đổng GPE giúp cho mình sáng mắt ra.
Thú thật, tôi cũng có giải pháp của mình nhưng xét về mặt lập trình, hiệu quả thì không bằng ý tưởng của các bạn.
Tôi đã làm thế này:
Gom dịa chỉ tất cả các ô có giá trị (text, number, formula, ...) thành địa chỉ ô. Tìm max, min cột, dòng trong các vùng đó.
Mã:
Sub CheckRange()
Dim RngChk As String, Rng1 As String, Rng2 As String
Dim rMax As Long, rMin As Long, cMax As Long, cMin As Long, nTmp As Long
Dim vt1 As Long, vt2 As Long, ten As String, kytu As String
On Error Resume Next
Rng1 = Selection.SpecialCells(xlCellTypeConstants, 23).Address(, , xlR1C1)
Rng2 = Selection.SpecialCells(xlCellTypeFormulas, 23).Address(, , xlR1C1)
RngChk = Rng1 & "," & Rng2 & "Z"
rMin = Cells.Rows.Count
cMin = Cells.Columns.Count
vt1 = 1
Do
  ten = Mid(RngChk, vt1, 1)
  If ten = "R" Or ten = "C" Then
    vt1 = vt1 + 1
    vt2 = vt1
    Do
      kytu = Mid(RngChk, vt2, 1)
      If IsNumeric(kytu) = False Then
'        Stop
        nTmp = Mid(RngChk, vt1, vt2 - vt1)
        If nTmp > rMax And ten = "R" Then rMax = nTmp
        If nTmp < rMin And ten = "R" Then rMin = nTmp
        If nTmp > cMax And ten = "C" Then cMax = nTmp
        If nTmp < cMin And ten = "C" Then cMin = nTmp
        vt1 = vt2
        Exit Do
      Else
        vt2 = vt2 + 1
      End If
    Loop
  Else
    vt1 = vt1 + 1
  End If
Loop While vt1 < Len(RngChk)
MsgBox "rMin=" & rMin & " rMax=" & rMax & "    cMin=" & cMin & "   cMax=" & cMax
End Sub
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom