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

Liên hệ QC

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:
Vòn lặp phải chạy theo nguồn chứ sao lại chạy theo đích
PHP:
Function TRANSPOSES(rng As Range, col As Integer)
Application.Volatile
dong = Application.WorksheetFunction.RoundUp(rng.Count / col, 0)
ReDim arr2(1 To dong, 1 To col)
arr = rng.Value
m = 1
For i = 1 To UBound(arr, 1)
     For j = 1 To UBound(arr, 2)
     n = n + 1
     arr2(m, n) = arr(i, j)
     If n = col Then n = 0: m = m + 1
     Next j
   
Next i
TRANSPOSES = arr2
End Function
Nguồn là gì mà đích là gì bác có thể nói rõ hơn không ạ?
 
Upvote 0
Đi làm lãnh lương về bị vợ móc túi lấy hết: Nguồn là túi mình, đích là túi vợ
[Vui] Vậy con không hiểu là đúng rồi, vì con chưa vợ luôn.

Thật ra con vào GPE chưa được tháng, ngày con vào là ngày con tự học VBA, còn nhiều cái bất cập, vì con không có căn bản, con chỉ mò mẫm phục vụ cho công việc thôi, nhưng những góp ý của mọi người con đều tiếp thu ạ.
 
Upvote 0
[Vui] Vậy con không hiểu là đúng rồi, vì con chưa vợ luôn.
Túm lại là hiểu chưa? Nếu chưa hiểu thì nghe giải thích thêm nè:
Muốn lấy hết tiền từ túi chồng, thì vợ phải chạy 2 vòng lặp trên người anh chồng: 1 vòng chạy vét hết các túi trái phải, trong ngoài của cái áo (của chồng), 1 vòng chạy vét hết các túi trái phải trong ngoài, trước sau của quần anh chồng.
Chứ lặp trên các túi của vợ thì số túi áo cũng không giống nhau, số túi quần cũng không giống nhau (dù cho tổng số túi cũng có thể bằng nhau, và có cả trường hợp túi vợ nhiều hơn túi chồng và có thêm cả cái ruột tượng).
 
Upvote 0
Chiều nào cũng được hết.

PHP:
Option Explicit

Function TRANSPOSES2(ByVal rng As Range, ByVal ncol As Long)
    Dim num_cells As Long
    num_cells = rng.Cells.Count
    If num_cells = 1 Then TRANSPOSES2 = rng.Value2: Exit Function
    Dim data As Variant, i As Long, j As Long, r As Long, c As Long, ub1 As Long, ub2 As Long
    Dim res As Variant, num_rows As Long, item As Long
    num_rows = VBA.Fix(num_cells / ncol) + 1
    data = rng.Value2
    ub1 = UBound(data, 1)
    ub2 = UBound(data, 2)
    ReDim res(1 To num_rows, 1 To ncol)
    r = 1
    c = 1
    For i = 1 To num_rows
        For j = 1 To ncol
            item = item + 1
            res(i, j) = data(r, c)
            r = r + 1
            c = c + 1
            If r > ub1 Then r = 1
            If c > ub2 Then c = 1
            If item >= num_cells Then GoTo end_code
        Next j
    Next i
end_code:
    TRANSPOSES2 = res
End Function
 
Upvote 0
num_rows = VBA.Fix(num_cells / ncol) + 1
Trích từ công thức chuyển mảng 1 chiều sang 2 chiều:
= VBA.Fix((num_cells - 1) / ncol) + 1

r = r + 1
c = c + 1
If r > ub1 Then r = 1
If c > ub2 Then c = 1
r = IIF(r >= ub1, 1, r + 1)
c = IIF(c >= ub2, 1, c + 1)
Hoặc dùng công thức chuyển i*j (phần tử thứ n của mảng 1 chiều) thành r, c (mảng 2 chiều)
 
Upvote 0
Túm lại là hiểu chưa? Nếu chưa hiểu thì nghe giải thích thêm nè:
Muốn lấy hết tiền từ túi chồng, thì vợ phải chạy 2 vòng lặp trên người anh chồng: 1 vòng chạy vét hết các túi trái phải, trong ngoài của cái áo (của chồng), 1 vòng chạy vét hết các túi trái phải trong ngoài, trước sau của quần anh chồng.
Chứ lặp trên các túi của vợ thì số túi áo cũng không giống nhau, số túi quần cũng không giống nhau (dù cho tổng số túi cũng có thể bằng nhau, và có cả trường hợp túi vợ nhiều hơn túi chồng và có thêm cả cái ruột tượng).
Dạ hiểu rồi, con cảm ơn!
[Vui]Mà cái chỗ "ruột tượng" này cấn cấn nè :lol:
 
Lần chỉnh sửa cuối:
Upvote 0
Vòn lặp phải chạy theo nguồn chứ sao lại chạy theo đích
PHP:
Function TRANSPOSES(rng As Range, col As Integer)
Application.Volatile
dong = Application.WorksheetFunction.RoundUp(rng.Count / col, 0)
ReDim arr2(1 To dong, 1 To col)
arr = rng.Value
m = 1
For i = 1 To UBound(arr, 1)
     For j = 1 To UBound(arr, 2)
     n = n + 1
     arr2(m, n) = arr(i, j)
     If n = col Then n = 0: m = m + 1
     Next j
  
Next i
TRANSPOSES = arr2
End Function
Code vừa ngắn, vừa dễ hiểu ,vừa mở rộng hơn, code con viết dài ngoằn mà chỉ lấy được mỗi [1] cột.
Code của bác cứ lấy hết cột(nguồn) thì xuống dòng(nguồn) lấy tiếp, bỏ vào cột(đích), tới khi nào cột(đích) = col(biến) thì cột(đích) Reset lại và xuống 1 dòng(đích).
 
Upvote 0
Tôi vẫn có thắc mắc:
Số phần tử của dữ liệu nguồn là xác định, trong khi số phần tử của mảng kết quả có khi lớn hơn. Vậy tại sao lặp theo dòng-cột của kết quả rồi mất công If ... Goto?
Tư duy vét tận hết nguồn bỏ vô đích có vẻ thuận hơn là tư duy thồn đầy đích đến khi hết nguồn chứ nhỉ?
 
Upvote 0
Tôi vẫn có thắc mắc:
Số phần tử của dữ liệu nguồn là xác định, trong khi số phần tử của mảng kết quả có khi lớn hơn. Vậy tại sao lặp theo dòng-cột của kết quả rồi mất công If ... Goto?
Tư duy vét tận hết nguồn bỏ vô đích có vẻ thuận hơn là tư duy thồn đầy đích đến khi hết nguồn chứ nhỉ?
Nguồn và đích là khái niệm tương đối thôi anh. Và tùy theo cách gọi của mỗi người.
Theo cách gọi nguồn và đích như anh nêu thì:
Code ở bài #2802 tham chiếu theo nguồn. Kiểu gieo sạ, gieo vãi, có thể đứng trên bờ, ôm thúng (mủng) thóc (đã ngâm ủ nứt mầm) ném xuống ruộng, tới khi hết thúng thì về.
Code ở bài #2808 tham chiếu theo đích. Kiểu lội xuống ruộng cấy từng cây/ khóm mạ con, tới khi hết cây mạ con thì lên bờ.
 
Upvote 0
Code ở bài #2802 tham chiếu theo nguồn. Kiểu gieo sạ, gieo vãi, có thể đứng trên bờ, ôm thúng (mủng) thóc (đã ngâm ủ nứt mầm) ném xuống ruộng, tới khi hết thúng thì về.
Code ở bài #2808 tham chiếu theo đích. Kiểu lội xuống ruộng cấy từng cây/ khóm mạ con, tới khi hết cây mạ con thì lên bờ.
Lập luận thì hay, nhưng ví dụ thì chèn ép.
Gieo sạ, gieo vãi đó là gieo hạt giống, kết quả là mạ. Lội xuống ruộng là hành động cấy mạ thẳng hàng. Cùng là việc gán kết quả từng phần tử mà biến thành 2 hành động khác nhau. So sánh kiểu này khiến người đọc chê lão chết tiệt là vãi thóc toè loe cho xong việc, không bằng bi phèn cấy mạ chăm chút từng cây. Puồn quá
 
Upvote 0
Thiệt ra nếu dùng For Each thì không cần biết dữ liệu gốc là cột hay dòng (chỉ một dòng hoặc một cột, bài #2801)
i = 0
j = numCot
For Each x In Rg.Value
j = j + 1
If j >= numCot
j = 1
i = i + 1
End If
a(i, j) = x
Next x
 
Upvote 0
Thiệt ra nếu dùng For Each thì không cần biết dữ liệu gốc là cột hay dòng (chỉ một dòng hoặc một cột, bài #2801)
Thiệt ra tôi cũng có nghĩ đến For each, nhưng for each với range hoặc mảng bị mặc định dòng trước cột sau, nếu cần cột trước dòng sau thì phải viết lại. Hai vòng for (i, j) thì chỉ cần hoán đổi vị trí 2 dòng for.
 
Upvote 0
nếu cần cột trước dòng sau thì chỉ cần hoán đổi vị trí 2 dòng for.
Bài toán này nếu mở rộng sẽ có 4 tuỳ chọn và cần thêm 2 tham số
dòng trước cột sau/ ngược lại cho nguồn
dòng trước cột sau/ ngược lại cho kết quả

1604666327032.png

PHP:
Function TRANSPOSES(Rng As Range, Col As Long, Optional DataRowFirst As Boolean = True, Optional ResultRowFirst As Boolean = True)
Dim Rw As Long, DataArr(), ReArr()
Rw = VBA.Fix(Rng.Count / Col) + 1
ReDim ReArr(1 To Rw, 1 To Col)
DataArr = Rng.Value
m = IIf(ResultRowFirst, 1, 0)
n = IIf(ResultRowFirst, 0, 1)

For i = 1 To IIf(DataRowFirst, UBound(DataArr, 1), UBound(DataArr, 2))
    For j = 1 To IIf(DataRowFirst, UBound(DataArr, 2), UBound(DataArr, 1))
        If ResultRowFirst Then
            n = n + 1
            If DataRowFirst Then
                ReArr(m, n) = DataArr(i, j)
            Else
                ReArr(m, n) = DataArr(j, i)
            End If
            If n = Col Then n = 0: m = m + 1
        Else
            m = m + 1
            If DataRowFirst Then
                ReArr(m, n) = DataArr(i, j)
            Else
                ReArr(m, n) = DataArr(j, i)
            End If
            If m = Rw Then m = 0: n = n + 1
        End If
     Next j
Next i
TRANSPOSES = ReArr
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Em chào A/C,
Đoạn code dưới đây đang so sánh số SeriesNumber với 1 số đã set cho MycomputerSeries. Bây giờ Em muốn sửa đoạn code này, cho so sánh số SeriesNumber với 1 vùng Sheet1.Range("C1:C10") nếu trong vùng C1:C10 không có 1 số nào trùng với số SeriesNumber. thì hiện thông báo "Máy này không được quyền sử dụng". Còn nếu trong vùng C1:C10 chỉ cần có 1 số trùng với số SeriesNumber thì sẽ hiện thông báo "Bạn đã xem được file". Mong A/C giúp đỡ. Cảm ơn A/C nhiều!

......
If SeriesNumber <> MyComputerSeries Then
MsgBox "May nay khong duoc quyen su dung"
GoTo ExitSub
......
 
Lần chỉnh sửa cuối:
Upvote 0
A chéo cờ chào e mờ nha.

PHP:
Private Function FindSeriesNumber(ByVal rng as Range, ByVal str_seri As String, _
                            Optional ByVal bol_MatchCase As Boolean = False) As Boolean
    'Tra ve True neu tim thay, nguoc lai tra ve False'
    'bol_MatchCase = False: Khong phan biet chu hoa, thuong. True = Co phan biet chu hoa, thuong'
   
    FindSeriesNumber = False
    Dim cll As Range
    Set cll = rng.Find(str_seri, MatchCase:=bol_MatchCase)
    If Not cll Is Nothing Then FindSeriesNumber = True
End Function
PHP:
Sub vidu()
Dim rng as range, res as Boolean
Dim str_seri as string
set rng = sheet1.range("C1:C10")
res = FindSeriesNumber(rng, str_seri)
If res = False then
msgbox "Không tìm thấy!"
else
msgbox "Cảm ơn a chéo cờ nhiều!"
End if
End Sub
 
Upvote 0
A chéo cờ chào e mờ nha.

PHP:
Private Function FindSeriesNumber(ByVal rng as Range, ByVal str_seri As String, _
                            Optional ByVal bol_MatchCase As Boolean = False) As Boolean
    'Tra ve True neu tim thay, nguoc lai tra ve False'
    'bol_MatchCase = False: Khong phan biet chu hoa, thuong. True = Co phan biet chu hoa, thuong'
  
    FindSeriesNumber = False
    Dim cll As Range
    Set cll = rng.Find(str_seri, MatchCase:=bol_MatchCase)
    If Not cll Is Nothing Then FindSeriesNumber = True
End Function
PHP:
Sub vidu()
Dim rng as range, res as Boolean
Dim str_seri as string
set rng = sheet1.range("C1:C10")
res = FindSeriesNumber(rng, str_seri)
If res = False then
msgbox "Không tìm thấy!"
else
msgbox "Cảm ơn a chéo cờ nhiều!"
End if
End Sub
Cảm ơn Anh befaint nhiều!
 
Upvote 0
Web KT
Back
Top Bottom