Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
NHN_Phương đã viết:
Xin chào các bạn,
Khi OT muốn copy 1 dòng được lựa chọn, OT làm như sau:
Mã: 
Sub ThemDong()
    Dim i As Integer
    i = Selection.Row
    Rows(i & ":" & i).Copy
    Rows(i & ":" & i).Insert Shift:=xlUp
End Sub

Nhưng khi OT muốn copy những dòng được lựa chọn thì OT viết như sau:
Mã: 
Sub ThemDong()
    Dim i As Integer, r As Range
    For Each r In Selection
        i = r.Row
        Rows(i & ":" & i).Copy
        Rows(i & ":" & i).Insert Shift:=xlUp
    Next r
End Sub

Nếu chọn xen kẽ các ô thì không sao (A1,A3,A10,...), còn khi chọn liền nhau(A1,A3:A5) thì code nó lặp không nghỉ ạ.
Nhờ các bạn xử giúp vòng lặp ạ hic,
Nhấp chuột vào đây để mở rộng...
Bạn Insert dòng luôn trong phần chọn thì phần chọn cứ mở rộng ra mãi, vòng lặp sao ngừng được
 
Upvote 0
Luôn luôn và luôn luôn nhớ: xóa và thêm dòng/ cột thì quay mông xinh xinh đi lùi.

PHP: 
Sub ThemDong()
    Dim i As Long, cell_ As Range
    Dim rng As Range, r As Long
    Set rng = Selection
    Dim a As Variant
    ReDim a(1 To rng.Cells.Count)
    For Each cell_ In rng
        i = i + 1
        a(i) = cell_.Row
    Next cell_
    For i = UBound(a) To 1 Step -1
        r = a(i)
        Rows(r & ":" & r).Copy
        Rows(r & ":" & r).Insert Shift:=xlUp
        Application.CutCopyMode = False
    Next i
End Sub
 
Upvote 0
befaint đã viết:
Luôn luôn và luôn luôn nhớ: xóa và thêm dòng/ cột thì quay mông xinh xinh đi lùi.

PHP: 
Sub ThemDong()
    Dim i As Long, cell_ As Range
    Dim rng As Range, r As Long
    Set rng = Selection
    Dim a As Variant
    ReDim a(1 To rng.Cells.Count)
    For Each cell_ In rng
        i = i + 1
        a(i) = cell_.Row
    Next cell_
    For i = UBound(a) To 1 Step -1
        r = a(i)
        Rows(r & ":" & r).Copy
        Rows(r & ":" & r).Insert Shift:=xlUp
        Application.CutCopyMode = False
    Next i
End Sub
Nhấp chuột vào đây để mở rộng...
Úi xời, nhìn tưởng đơn giản mà cũng phực tạp thật.
Đúng là phải đi lùi ạ :D, ngoài sử dụng vòng lặp For ra có thể sử dụng Do với 1 vòng hay sử dụng Union gì đó được không Bạn?
 
Upvote 0
befaint đã viết:
Có gì đâu mà không đơn giản.
Khúc lấy địa chỉ dòng thì thêm loại trùng vào là xong thôi.
Nhấp chuột vào đây để mở rộng...
OT thấy khó là vì có thể chỗ thì chọn một cột còn chỗ thì quét nhiều cột, không đồng nhất về số cột của mỗi vùng được lựa chọn ấy Bạn.
 
Upvote 0
befaint đã viết:
Chiêu này gọi là chiêu thiên nga múa đó hả.

Chép cho dẻo tay nhé.

View attachment 252927
Nhấp chuột vào đây để mở rộng...

'Đại ca' ơi xem giúp 'em' lỗi này là lỗi gì vớii ạ:fish:

1610544847310.png
Mã: 
Option Explicit

Sub ThemDong()
    Dim i As Long, r As Long, a As Variant
    Dim cell_ As Range, rng As Range
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set rng = Selection
    Dim oArrList As Object
    Set oArrList = CreateObject("System.Collections.ArrayList")
    For Each cell_ In rng
        r = cell_.Row
        If oArrList.Contains(r) = False Then
            oArrList.Add r
        End If
    Next cell_
    If oArrList.Count = 0 Then Exit Sub
    oArrList.Sort
    a = oArrList.ToArray
    For i = UBound(a) To LBound(a) Step -1
        r = a(i)
        Rows(r & ":" & r).Copy
        Rows(r & ":" & r).Insert Shift:=xlUp
        Application.CutCopyMode = False
    Next i
    Set oArrList = Nothing: Erase a: Set rng = Nothing
End Sub
 
Upvote 0
A! Được rồi, tuyệt vời cảm ơn Bạn @befaint ,
thì ra 'System.Collections.ArrayList' nó không thích hợp với 'NET 4.0' mà thích hợp với 'NET 3.5'

stackoverflow.com

automation error -2146232576 (80131700) on creating an array

I have a macro that's working on one computer just fine, however when I try to run it on another computer I get the following error: Run-time error '-2146232576 (80131700)' Automation error Here'...
stackoverflow.com stackoverflow.com

Ơ nhưng mà nếu vậy thì code này nếu chuyển sang máy tính khác đang mặc định 'NET 4.0' thì sẽ không chạy được nếu không cài 'NET 3.5' ạ?
 
Upvote 0
ptm0412 đã viết:
Thì xài Dictionary đi
Nhấp chuột vào đây để mở rộng...
Chú Mỹ nay có hứng thú không ạ, chú chỉ giúp con cái xài 'Dictionary' 'cho chiêu thiên nga múa với vùng chọn này với chú Mỹ :
Mã: 
Range("B3:D4,C6:J7,A9:E12").Select
Con thấy code của bạn @befaint xử lý được chiêu này rồi ạ.
 

File đính kèm

  • Them dong lua chon.xlsm
    18.3 KB · Đọc: 10
Upvote 0
ptm0412 đã viết:
Học befaint còn chưa hết chiêu mà tham lam. Thế đã nhớ vụ "quay mông xinh xinh đi lùi" chưa?
Nhấp chuột vào đây để mở rộng...
Vụ này chiều nay con cười xái cả quai hàm nên quên sao dễ được ạ. --=0
Hôm nay con còn biết thêm được nữa là code cần phải 'tét trong phòng thí nghiệm' nữa ahihi nẫu hết cả ruột.
Ai bảo chú gợi ý, mà khi đã còn cách là con sẽ phải cố xem cách nào nó tiện nhất vì không chỉ làm cho mỗi bản thân mình dùng mà còn cho người khác dùng để không làm phiền người khác, người khác cũng không gọi đến mình thì con chọn ạ.
 
Upvote 0
NHN_Phương đã viết:
Ai bảo chú gợi ý, mà khi đã còn cách là con sẽ phải cố xem cách nào nó tiện nhất
Nhấp chuột vào đây để mở rộng...
Dictionary thua Collections.ArrayList vì ArrayList có phương thức sort, do đó Dict. phải chạy đường vòng và chậm hơn. Không hứng mấy nên chưa tối ưu
PHP: 
Sub CopyInsertSelection()
Dim Dict, Arr()
Dim Cll As Range, i As Long, k As Long, lastRw As Long
Application.ScreenUpdating = False
lastRw = Cells(10000, 3).End(xlUp).Row
Set Dict = CreateObject("Scripting.Dictionary")
ReDim Arr(1 To lastRw, 1 To 1)
For Each Cll In Selection
    If Not Dict.exists(Cll.Row) Then
        Dict.Add Cll.Row, ""
        Arr(Cll.Row, 1) = Cll.Row
    End If
Next
For i = lastRw To 1 Step -1
    If Arr(i, 1) > 0 Then
        k = Arr(i, 1)
        Cells(k, 1).EntireRow.Copy
        Cells(k, 1).Insert Shift:=xlDown
    End If
Next
Set Dict = Nothing: Set Cll = Nothing: Erase Arr
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
ptm0412 đã viết:
Dictionary thua Collections.ArrayList vì ArrayList có phương thức sort, do đó Dict. phải chạy đường vòng và chậm hơn. Không hứng mấy nên chưa tối ưu
PHP: 
Sub CopyInsertSelection()
Dim Dict, Arr()
Dim Cll As Range, i As Long, k As Long, lastRw As Long
Application.ScreenUpdating = False
lastRw = Cells(10000, 3).End(xlUp).Row
Set Dict = CreateObject("Scripting.Dictionary")
ReDim Arr(1 To lastRw, 1 To 1)
For Each Cll In Selection
    If Not Dict.exists(Cll.Row) Then
        Dict.Add Cll.Row, ""
        Arr(Cll.Row, 1) = Cll.Row
    End If
Next
For i = lastRw To 1 Step -1
    If Arr(i, 1) > 0 Then
        k = Arr(i, 1)
        Cells(k, 1).EntireRow.Copy
        Cells(k, 1).Insert Shift:=xlDown
    End If
Next
Set Dict = Nothing: Set Cll = Nothing: Erase Arr
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Ơ, con mang code vào phòng thí nghiệm để tét với chiêu thiên nga múa các kiểu, kết quả tuyệt vời không kém gì phương pháp của Bạn @befaint chú Mỹ ơi .
Không có cảm giác chậm lắm chú Mỹ,thay vì phải xử lý từng dòng trên bảng tính thì kết hợp với Union gàn hết vào một thể xong rồi xử lý một lần được không chú Mỹ nhỉ?
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

P
Unsurpassed Сasual Dating - Legitimate Girls
Trả lời
0
Đọc
15
pta289
P
kiencuong030184
  • Question
ẩn hiện dòng, cột có điều kiên
Trả lời
0
Đọc
16
kiencuong030184
kiencuong030184
A
[Góc giúp đỡ] Tìm kiếm, lọc và lấy dữ liệu từ nhiều file Word cấu trúc giống nhau vào 1 file excel mẫu
Trả lời
4
Đọc
96
Hoàng Tuấn 868
H
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
1
Đọc
36
VetMini
V
Emyeuexcel
In theo số thứ tự
Trả lời
2
Đọc
49
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom