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

maytinhvp01 · 31/7/13

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]

namdat2 · 14/11/18

Mình muốn dò cả workbook thì dùng lệnh gì cho đúng

vn.danhmay · 14/11/18

SA_DQ đã viết:
Bạn sửa dòng lệnh đầu tiên thành vầy, chắc được:

Mã:

Dim sArr(), dArr() As Variant, I As Long, J As Long

Em đổi xong thì code chạy nhưng không ra được gì hết ạ

snow25 · 14/11/18

vn.danhmay đã viết:
Em đổi xong thì code chạy nhưng không ra được gì hết ạ [/QUOTE

đúng rồi code của bạn nó có tìm ra cái gì đâu mà chẳng không ra vì bạn chọn sai vùng để so sánh các tham số với nhau.

vn.danhmay · 14/11/18

Bác có thể chỉ em cách sửa không ạ. Em ngồi mò nãy giờ mà không ra ạ

SA_DQ · 14/11/18

vn.danhmay đã viết:
Em đổi xong thì code chạy nhưng không ra được gì hết ạ

Sau dòng lệnh
End
thì là những dòng lệnh viết cho vui mà!

vn.danhmay · 14/11/18

SA_DQ đã viết:
Sau dòng lệnh
End
thì là những dòng lệnh viết cho vui mà!

À hình như chỗ đó là dòng end if mà nó báo lỗi nên em bỏ chữ if đi ạ

Bác có thể sửa code giúp em để cho nó hoạt động được không ạ

VetMini · 14/11/18

vn.danhmay đã viết:
Em có chút rắc rối với file này ạ
Chạy code nó cứ báo lỗi type Missmatch ạ

Mục đích là lọc dữ liệu theo yêu cầu ạ

Phạm vi của If dieukien... sẽ dừng lại ở chỗ ????. Khối If sẽ KHÔNG bao gồm khối For đi kế nó. Vì vậy End sau khói For ấy hoàn toàn chẳng 'end' ai cả.

Mã:

...
For i = 1 To UBound(sArr, 1)
If sArr(i, 2) = "" Then day = sArr(i, 1)

If dieukien = sArr(i, cot) Then dArr(i, 1) = day ' ??????????
  
    For j = 1 To UBound(sArr, 2)
    dArr(i, j + 1) = sArr(i, j)
    Next j
    End

Next i
Sheets("filter").Delete
...

vn.danhmay · 14/11/18

Em đã sửa được ròi ạ

cám ơn các bác

snow25 · 14/11/18

VetMini đã viết:
Phạm vi của If dieukien... sẽ dừng lại ở chỗ ????. Khối If sẽ KHÔNG bao gồm khối For đi kế nó. Vì vậy End sau khói For ấy hoàn toàn chẳng 'end' ai cả.

Mã:

... For i = 1 To UBound(sArr, 1) If sArr(i, 2) = "" Then day = sArr(i, 1) If dieukien = sArr(i, cot) Then dArr(i, 1) = day ' ?????????? For j = 1 To UBound(sArr, 2) dArr(i, j + 1) = sArr(i, j) Next j End Next i Sheets("filter").Delete ...

câu lệnh end ở đấy nó có ảnh hưởng gì đến code ở dưới không bác mà nó đặt ở đây thì nó kết thúc cái gì ạ.

tam888 · 14/11/18

snow25 đã viết:
câu lệnh end ở đấy nó có ảnh hưởng gì đến code ở dưới không bác mà nó đặt ở đây thì nó kết thúc cái gì ạ.

không, nó kết thúc sub/fuction đó luôn, nên các lệnh dưới không có tác dụng gì

vn.danhmay · 14/11/18

Đây là thành quả sau cùng của em ạ

Mã:

Sub tachdulieu()

    Dim sArr, dArr As Variant, i As Long, j As Long
    Dim dieukien As Variant, daykh As String, Col As Long

With Sheets("Sheet1")

dieukien = Range("I1").Value
Col = Range("J1").Value

sArr = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 7).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2) + 1)
For i = 1 To UBound(sArr, 1)
If Left(sArr(i, 1), 3) = "day" Then daykh = sArr(i, 1)

If dieukien = sArr(i, Col) Then
    K = K + 1
    dArr(K, 1) = daykh
    For j = 1 To UBound(sArr, 2)
    dArr(K, j + 1) = sArr(i, j)
    Next j

End If
Next i

End With

On Error GoTo tiep

Application.DisplayAlerts = False
Application.Sheets("loc_data").Delete

tiep:
Application.Sheets.Add Application.Sheets(1)
Application.Sheets(1).Name = "loc_data"
Sheets(1).Range("A1").Resize(UBound(dArr, 1), UBound(dArr, 2)) = dArr

Application.DisplayAlerts = True
End Sub

VetMini · 14/11/18

snow25 đã viết:
câu lệnh end ở đấy nó có ảnh hưởng gì đến code ở dưới không bác mà nó đặt ở đây thì nó kết thúc cái gì ạ.

tam888 đã viết:
không, nó kết thúc sub/fuction đó luôn, nên các lệnh dưới không có tác dụng gì

Xin lỗi. Ở trên tôi nói "chẳng end cái gì cả" là ý muốn nói đến mấy cái blocks. Đọc lại mới nhận ra mình nói hấp tấp quá cho nên nghĩa hoàn toàn trái ngược.
Lệnh "End" nó ngưng tất cả, ngưng chạy code, giải thoát biến trong bộ nhớ, và đóng các files mà nó mở bằng lệnh "Open" (những file mở bằng cách khác thì chưa chắc)

befaint · 14/11/18

VetMini đã viết:
Lệnh "End" nó ngưng tất cả, ngưng chạy code, giải thoát biến trong bộ nhớ, và đóng các files mà nó mở bằng lệnh "Open" (những file mở bằng cách khác thì chưa chắc)

Em thấy không đóng những files đó anh.

Em nhớ mang máng thì "End" bằng với nút "Reset".

VetMini · 15/11/18

Theo tôi biết thì End nó sẽ dọn rác. Mà dọn rác thì nó sẽ đóng các cửa mà nó mở ra. Lệnh Open mở files I/O theo cửa channel cho nên nó đóng là hợp lý.
Open FilePath For Input As #1 ' đọc file qua channel số 1

Tuy nhiên, tôi rất ít khi làm việc với channel I/O. Lại càng hiếm dùng lệnh End cho nên chưa có dịp thử nghiệm.

Lưu ý là các files mở bằng các Objects trong thư viện (điển hình FileSystemObject) là chuyện khác hoàn toàn.

thanhliem_mta · 15/11/18

Cả nhà giúp e với, e compile mà cứ báo sub or funcion not defined
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, picname As String
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([G9], Target) Is Nothing Then
Set Rng = Sheet(1).Range(Sheet(1).[B8], Sheet(1).[B1000].End(x1Up))
picname = ThisWorkbook.Path & "\Hinh\" & Rng.Find(Target).Offset(, 14)
Sheet (2), Shapes([I5].Address).Delete
[I5].Select
With ActiveSheet.Picture.Insert(picname)
'.Name = Target.Offset (1,0).Address
.Name = [I5].Address
'. Left = Target.Offset (1,0).Left: Top = target.Offset (1,0).Top
'. Left = [I5].Left: Top = [I5].Top
Width = 100 '(pixcels)
Height = 150 ' (pixcels)
End With
ActiveSheet.Shapes("$I$5").IncrementTop 30#
ActiveSheet.Shapes("$I$5").IncrementLeft 0
End If
Application.ScreenUpdating = True
End Sub

befaint · 15/11/18

Ở khung viết bài có nút </> chuyên để trị những thằng là code, công thức ấy.

PHP:

x1

thanhliem_mta · 15/11/18

Chào bạn befaint, mình đã sửa lại code và k báo lỗi nữa, nhưng nó chỉ con trỏ vào ô mình muốn hiện ảnh nhưng lại k load được ảnh lên, bạn giúp mình với, code mình sửa
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Picname As String
Dim Width As Integer
Dim Height As Integer
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([G9], Target) Is Nothing Then
Set Rng = Sheet1.Range(Sheet1.[B8], Sheet1.[B1000].End(xlUp))
Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Find("Target").Offset(0, 14)
Sheet2.Shapes([I5].Address).Delete
[I5].Select
With ActiveSheet.Picture.Insert(Picname)
.Name = [I5].Address
Width = 100
Height = 150
End With
ActiveSheet.Shapes("$I$5").IncrementTop 30#
ActiveSheet.Shapes("$I$5").IncrementLeft 0
End If
Application.ScreenUpdating = True
End Sub

batman1 · 16/11/18

thanhliem_mta đã viết:
Chào bạn befaint, mình đã sửa lại code và k báo lỗi nữa, nhưng nó chỉ con trỏ vào ô mình muốn hiện ảnh nhưng lại k load được ảnh lên, bạn giúp mình với, code mình sửa

Tại sao bạn không sửa bài khi đã được nhắc?
Bôi đen toàn bộ code rồi nhấn nút Code để cho nó vào thẻ như trong bài của tôi dưới đây.

Nếu muốn lần sau được giúp thì hãy sửa lại.

Sai:
1. Find(Target.Value) hoặc Find(Target) chứ không phải Find("Target")
2. ActiveSheet.Pictures chứ không phải ActiveSheet.Picture
3. Kod hiện hành nhập ảnh vào ActiveSheet nhưng Sheet2 không được kích hoạt nên ActiveSheet vẫn là Sheet1, tức ảnh được nhập vào Sheet1 không đúng dụng ý.
4.

Mã:

With ActiveSheet.Picture.Insert(Picname)
.Name = [I5].Address
Width = 100
Height = 150
End With

Width, Height không dùng ở các phần sau thì thiết lập làm gì cho tốn điện nước? Còn nếu tôi đoán được dụng ý thì phải là .Width, .Height, nhưng lúc đó khai báo Width, Height là thừa.

5. Với code ở dưới thì trong cột P phải có tên ảnh và định dạng. Tức vd. hichic.jpg chứ không được chỉ hichic. Nếu các ảnh đều có định dạng JPG thì chỉ nên nhập tên ảnh (hichic) trong cột P và sửa

Mã:

Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value

thành

Mã:

Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value & ".jpg"

6. Code

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Picname As String
Dim fso As Object
    Application.ScreenUpdating = False
    If Target.Address = "$G$9" Then
        Set Rng = Sheet1.Range(Sheet1.[B8], Sheet1.[B1000].End(xlUp))
        Set Rng = Rng.Find(Target.Value)  ' hoac Rng.Find(Target)
        If Not Rng Is Nothing Then
            Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.fileexists(Picname) Then
                With Sheet2
                    On Error Resume Next
                    .Shapes("$I$5").Delete
                    On Error GoTo 0
                    With .Pictures.Insert(Picname)
                        .Name = "$I$5"
                        .ShapeRange.LockAspectRatio = msoFalse
                        .Placement = xlMoveAndSize
                        .Left = Sheet2.Range("I5").Left
                        .Top = Sheet2.Range("I5").Top
                        .width = 100
                        .height = 150
                    End With
                End With
            End If
            Set fso = Nothing
        End If
    End If
    Application.ScreenUpdating = True
End Sub

thanhliem_mta · 16/11/18

batman1 đã viết:
Tại sao bạn không sửa bài khi đã được nhắc?
Bôi đen toàn bộ code rồi nhấn nút Code để cho nó vào thẻ như trong bài của tôi dưới đây.

Nếu muốn lần sau được giúp thì hãy sửa lại.

Sai:
1. Find(Target.Value) hoặc Find(Target) chứ không phải Find("Target")
2. ActiveSheet.Pictures chứ không phải ActiveSheet.Picture
3. Kod hiện hành nhập ảnh vào ActiveSheet nhưng Sheet2 không được kích hoạt nên ActiveSheet vẫn là Sheet1, tức ảnh được nhập vào Sheet1 không đúng dụng ý.
4.

Mã:

With ActiveSheet.Picture.Insert(Picname) .Name = [I5].Address Width = 100 Height = 150 End With

Width, Height không dùng ở các phần sau thì thiết lập làm gì cho tốn điện nước? Còn nếu tôi đoán được dụng ý thì phải là .Width, .Height, nhưng lúc đó khai báo Width, Height là thừa.

5. Với code ở dưới thì trong cột P phải có tên ảnh và định dạng. Tức vd. hichic.jpg chứ không được chỉ hichic. Nếu các ảnh đều có định dạng JPG thì chỉ nên nhập tên ảnh (hichic) trong cột P và sửa

Mã:

Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value

thành

Mã:

Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value & ".jpg"

6. Code

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range, Picname As String Dim fso As Object Application.ScreenUpdating = False If Target.Address = "$G$9" Then Set Rng = Sheet1.Range(Sheet1.[B8], Sheet1.[B1000].End(xlUp)) Set Rng = Rng.Find(Target.Value) ' hoac Rng.Find(Target) If Not Rng Is Nothing Then Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value Set fso = CreateObject("Scripting.FileSystemObject") If fso.fileexists(Picname) Then With Sheet2 On Error Resume Next .Shapes("$I$5").Delete On Error GoTo 0 With .Pictures.Insert(Picname) .Name = "$I$5" .ShapeRange.LockAspectRatio = msoFalse .Placement = xlMoveAndSize .Left = Sheet2.Range("I5").Left .Top = Sheet2.Range("I5").Top .width = 100 .height = 150 End With End With End If Set fso = Nothing End If End If Application.ScreenUpdating = True End Sub

Bài đã được tự động gộp: 16/11/18

Cảm ơn bạn Batman1, mình đã thành công rồi. Cảm ơn bạn nhiều lắm
Bạn Batman 1 ơi, cho mình hỏi chút: Nếu bây giờ mình có 2 tên nhân viên giống nhau nhưng là 2 người khác nhau, nếu tìm theo tên thì làm sao để hiện ảnh lên được? Giúp mình với

thanhliem_mta · 16/11/18

Cảm ơn bạn nhiều lắm

Bài đã được tự động gộp: 16/11/18

thanhliem_mta đã viết:
Bài đã được tự động gộp: 16/11/18

Cảm ơn bạn Batman1, mình đã thành công rồi. Cảm ơn bạn nhiều lắm

befaint đã viết:
Ở khung viết bài có nút </> chuyên để trị những thằng là code, công thức ấy.

PHP:

x1

Cảm ơn bạn rất nhiều

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

Thành viên thường trực

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên mới

/(hông là gì!

Thành viên mới

Ăn cùng góc phố

Thành viên mới

Thành viên gạo cội

Thành viên tích cực

Thành viên mới

Ăn cùng góc phố

|||||||||||||

Ăn cùng góc phố

Thành viên mới

File đính kèm

|||||||||||||

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

Facebook

Group