5 và E7:F10 thì các dòng của target là 1, 2, 3, 4, 5, 7, 8, 9, 10, các bạn cho mình hỏi: làm thế nào để hiển thị các dòng của target.
Option Explicit
Sub HienDong()
Dim StrC As String, SChu As String: Dim Clls As Range
StrC = "GPE"
For Each Clls In Selection
If InStr(StrC, "R" & Clls.Row) < 1 Then
SChu = SChu & " " & Clls.Row
StrC = StrC & "R" & Clls.Row
End If
Next Clls
MsgBox SChu
End Sub
Bạn có thể nói mục đích của bạn được không?
Bạn thử code này thử xem
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim a As Integer
For Each Rng In Selection
If a < Rng.Row Then
MsgBox Rng.Row
a = Rng.Row
End If
Next
End SubOption Explicit[/color]
Sub HienDong()
Dim StrC As String, SChu As String: Dim Clls As Range
StrC = "GPE"
For Each Clls In Selection
If InStr(StrC, "R" & Clls.Row) < 1 Then
MsgBox Clls.Row
StrC = StrC & "R" & Clls.Row
End If
Next Clls
' MsgBox SChu '
End Sub
Nhưng mà Macro này thì nó hiện số không theo thứ tự gì hết. Cell nào được duyệt trước thì nó hiện trước chứ không theo một thứ tự nhất định.Macro này của HuuThang_BD chỉ đúng 1 chiều thôi, lúc mà chúng ta dùng chuột chọn các ô từ trên xuống( từ hàng bé đến hàng lớn);
Nếu cắt cớ chọn từ dưới lên sẽ chỉ cho 1 dòng duy nhứt mà thôi!
Ví dụ tôi chọn lần lượt là B9:C8, tiếp sau đó B2:A2 & C1
Nếu muốn mỗi lần đều hiễn thị thì còn bớt 1 dòng lệnh trong macro của mình nữa là đằng khác:
PHP:Option Explicit[/color] Sub HienDong() Dim StrC As String, SChu As String: Dim Clls As Range StrC = "GPE" For Each Clls In Selection If InStr(StrC, "R" & Clls.Row) < 1 Then MsgBox Clls.Row StrC = StrC & "R" & Clls.Row End If Next Clls ' MsgBox SChu ' End Sub
Đoạn Macro này cũng chưa đúng, nếu chọn A10 và F1 thì nó chỉ báo mỗi dòng 10 vìMacro này của HuuThang_BD chỉ đúng 1 chiều thôi, lúc mà chúng ta dùng chuột chọn các ô từ trên xuống( từ hàng bé đến hàng lớn);
Nếu cắt cớ chọn từ dưới lên sẽ chỉ cho 1 dòng duy nhứt mà thôi!
Ví dụ tôi chọn lần lượt là B9:C8, tiếp sau đó B2:A2 & C1
Nếu muốn mỗi lần đều hiễn thị thì còn bớt 1 dòng lệnh trong macro của mình nữa là đằng khác:
PHP:Option Explicit[/color] Sub HienDong() Dim StrC As String, SChu As String: Dim Clls As Range StrC = "GPE" For Each Clls In Selection If InStr(StrC, "R" & Clls.Row) < 1 Then MsgBox Clls.Row StrC = StrC & "R" & Clls.Row End If Next Clls ' MsgBox SChu ' End Sub
InStr("GPER10","R1")=4 '(>=1)Sub Hiendong()
Dim Rng As Range, MyRng As Range
Dim Str As String
Dim Row_ As Long
Set MyRng = Range(Replace(Selection.EntireRow.Address, "$", "A"))
For Each Rng In MyRng
If InStr(Str, "A" & Format(Rng.Row, "00000")) = 0 Then
Str = Str & "A" & Format(Rng.Row, "00000")
If Rng.Row > Row_ Then
Row_ = Rng.Row
End If
End If
Next
For i = 1 To Row_
If InStr(Str, "A" & Format(i, "00000")) > 0 Then
MsgBox i
End If
Next
End Sub
Không rõ ý của NDU có phải thế này không?
Sub Test()
Dim rng As Range
Set rng = Selection
Dim i As Long
Dim iRowTop As Long
Dim iRowBottom As Long
iRowTop = rng.Row
iRowBottom = iRowTop + rng.Rows.Count - 1
For i = 1 To rng.Areas.Count
If iRowTop > rng.Areas(i).Row Then iRowTop = rng.Areas(i).Row
If iRowBottom < rng.Areas(i).Row + rng.Areas(i).Rows.Count - 1 Then iRowBottom = rng.Areas(i).Row + rng.Areas(i).Rows.Count - 1
Next
For i = iRowTop To iRowBottom
If Not Intersect(Range(i & ":" & i), rng) Is Nothing Then MsgBox i
Next
End SubCách tôi làm cũng gần gần giống thế
Sub Test()
Dim i As Long, Clls As Range, k As Long
With Selection
For i = 1 To .Areas.Count
For Each Clls In .Areas(i).Resize(, 1)
If k < Clls.Row Then k = Clls.Row: MsgBox k
Next
Next
End With
End SubCác bài toán liên quan đến kế toán tôi không rành lắm (nhìn vào nó lơ mơ thế nào ấy) ---> Có lẽ phải xem các cao thủ (những ai chuyên ngành KT) làm trước mới đoán được ý bạn!Ng_Duy_Long đã viết:
Bạn yên tâm vì khi ráp vào toàn bộ code, cái Selection ấy đâu phải ta chọn bằng tay!
Code của tôi chính là đang muốn khắc phục nhược điểm này. Ở code của bạn có 2 vòng lặp, 1 vòng duyệt qua tất cả các Areas, 1 vòng duyệt qua tất cả các ô ở cột đầu tiên của mỗi Areas. Còn code của tôi cũng bao gồm 2 vòng lặp, 1 vòng duyệt qua tất cả các Areas(cái này giống của bạn), còn vòng lặp thứ 2 thì nó chỉ duyệt từ dòng trên cùng đến dòng cuối cùng của các Areas.
Ái dà.. đúng là sơ suất
Sub Test()
Dim BigRng As Range, i As Long, Clls As Range
With Selection
Set BigRng = .Areas(1)
For i = 1 To .Areas.Count
Set BigRng = Range(BigRng, .Areas(i))
Next i
For Each Clls In BigRng.Resize(, 1)
If Not Intersect(Clls.EntireRow, .Cells) Is Nothing Then MsgBox Clls.Row
Next Clls
End With
End Sub
