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

[maytinhvp01]

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]

 

[Hai Lúa Miền Tây]

Em thường phải trích lọc số liệu dựa vào mã ID. Có ID 5 số (Ví dụ 10001, 20001, 30001), hoặc 6 số (Ví dụ 100012, 200012, 300012)., hoặc 7 số (Ví dụ 1000123, 2000123, 3000123). Có cách đặt biến nào để chỉ các giá trị thỏa mãn điều kiện mình đặt ra (Ví dụ từ 10000 đến 29999) thì mới lấy các đầu số đó không mọi người? Em thì đang dùng hàm len đếm số lượng chữ số để loại... nhưng muốn làm theo kiểu khoanh vùng kia cho rõ ràng đỡ nhầm lẫn.

Nếu lọc dữ liệu = ADO thì có thể bạn dùng điều kiện Where Col In (1000123, 2000123, 3000123...)

 

[tueyennhi]

Nếu lọc dữ liệu = ADO thì có thể bạn dùng điều kiện Where Col In (1000123, 2000123, 3000123...)

Vậy thì khó rồi, hiện lọc của em còn dựa vào Dic vì chắt lọc từ rất nhiều sheet.

 

[Hai Lúa Miền Tây]

Vậy thì khó rồi, hiện lọc của em còn dựa vào Dic vì chắt lọc từ rất nhiều sheet.

Là sao bạn?

 

[tueyennhi]

Là sao bạn?

Chủ để của em trên diễn đàn thường chỉ xoay quanh chấm công lương. Về công, mỗi ngày công sẽ là một sheet và có một Sheet tổng hợp toàn bộ công của mọi người trong công ty. Mà cái ADO tuy rằng đã từng ứng dụng theo một chủ đề của anh (Tách một file thành nhiều file mà trong file chứa nhiều sheet) nhưng để mà tự xây dựng thì chắc phải học dài dài chưa chắc hiểu.

 

[toeic1]

Mọi người cho em hỏi với ak
Em có đoạn code sau:
Private Sub CommandButton2_Click()
Dim i As Integer
Dim x As Integer
Dim y As integer
i = Application.InputBox("KL do tai", , i)
x = Range("k9")
y = application.activecell
x = x + y
i = i - x
MsgBox "KL sau khi dieu phoi" & i
End Sub
Vấn đề ở đây là giá trị x sẽ bằng ô K9 cộng với giá trị y ở ô hiện hành. Sau mỗi lần tính em muốn lưu cái giá trị đó lại để thực hiện cho lần tính sau thì làm thế nào aj?

 

[Hoang2013]

Còn huyền ảo, nhưng cũng fán đại; Trúng trật hạ hồi fân giải:
Muốn xài lại kết quả tham biến thì ghi lại nó vô xó nào đó;
Ghi vô 1 biến toàn cục;
Ghi lên 1 ô còn lâu mới xài đến.
. . . .

Chúc thành công & vui vẻ ngày cuối tuần!

 

[sky_hungnguyen]

Thắc mắc về hàm Filter?
Mình có google và làm theo Hướng dẫn tạo ô tìm kiếm dữ liệu.
Nhưng có chút vấn đề như sau:
Sau khi nhập dữ liệu vào textbox thì đã lọc ra kết quả cần. Nhưng xóa đi thì table không trả về nguyên dạng mà vẫn bị filter 1 số dư liệu nào đó.
Code:
ActiveSheet.ListObjects("<Ten Table>").Range.AutoFilter Field:=1, _
Criteria1:="*" & [<Cell lấy dữ liệu>] & "*", Operator:=xlFilterValues

Các bác xử lý giùm mình vấn đề này với??
THANKS!

 

[Loannie]

Chào các bạn,

Mình tạo marco này để chuyển dữ liệu từ Sheet3 sang dạng Pivot Table và Tabular Form. Các bước như sau:
- Ctrl + Shift từ cột A tới cột H (số liệu sẽ cập nhật tiếp tục theo dòng) trong Sheet3
- Chọn tab Insert, chọn Pivot Table và tạo Pivot Table sang 1 sheet khác
- Sau khi tạo Pivot Table, ấn vào đó, để hiện lên PivotTable Tools => chọn tab Design => chọn không hiện Subtotals và Grand Totals trên báo cáo, và ấn vào Report Layout, chọn Show in Tabular Form.
- Lưu macro và chạy thử, báo lỗi.

Mình xin gửi file dữ liệu đây. Xin nhờ các chuyên gia chỉ dẫn.

Mình xin cảm ơn!

 

[chitbk]

Hi Anh Chị,, Mình có viết 1 function trong VBA. sau đó mình dùng đoạn code để copy function :
Worksheets("Strip Direct").Activate
'copycongthuc vung 1
Range(Sheet2.Cells(18, 3), Sheet2.Cells(19, 4)).Select
Selection.AutoFill Destination:=Range(Cells(18, 3), Cells(1000, 4)), Type:=xlFillDefault
Sau khi run xong thì các ô đã copy không tự động chạy ra giá trị. Mình phài vào từng ô để enter thì function mới chạy ra kết quả.Anh Chị Hướng dần giúp mình cách nào để function chạy ra kết quả. Cảm ơn Anh Chị
sau khi Enter từng Ô thì

 

[Đặng Anh Khoa]

Sử dụng những function key trong VBA
Em Ví dụ, Ô "L" đã có chữ "oke" sử record macro , em bấm F2 rồi chèn "_aa" nhưng nó không hiểu mà nó ra thế này

Range("L6").Select
ActiveCell.FormulaR1C1 = "oke_aa"

Mọi người giúp em với làm sao sử dụng F2 mà cho VBA nó hiểu được ạ.

 

[xitrum]

help!

macro này giúp mình gửi email từ excel
mình muốn thay vì nhập địa chỉ email vào code, mình muốn lấy email từ ô A20 chẳng hạn.
giúp mình với.

Sub Mail_Range()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:K15").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "huynhnguyenbinh@gmail.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[giaiphap]

help!

macro này giúp mình gửi email từ excel
mình muốn thay vì nhập địa chỉ email vào code, mình muốn lấy email từ ô A20 chẳng hạn.
giúp mình với.

Bạn sửa chổ

.to = "huynhnguyenbinh@gmail.com"

thành

.to = [A20]

thử xem.

 

[keke355992]

Các bạn cho mình hỏi chút là nên sử dụng: If sArr(i,j) <> "" hay là dùng if Not IsEmpty(sArr(i,j)) vậy. Nó có khác nhau nhiều ko vậy ?

 

[o2mobile]

Em chào các anh
Em đang ngâm cứu để viết code làm bản ảnh bằng VBA, khi mới vào bắt đầu đã gặp lỗi như sau:
- Em tạo function UNItoVBA nhằm chuyển mã unicode sang VBA. Nếu em chuyển ngoài => mã VBA thì khi gán vào setup nó lên. tuy nhiên khi không gán mà gán thông qua gọi hàm UNItoVBA thì nó không ra.
Em nhờ anh chỉ giúp ạ.
Em cám ơn.
=========================
Em gửi link file excel + lỗi
https://drive.google.com/open?id=1U__KyZGwAB4PIo0pSn274lmzqkeEw1nI
https://drive.google.com/open?id=1Hd8Ljw4W9aMhkHH-ySWfmuBd1J8lM_nC
=========================
Em gửi code ạ:
Private Sub btnnext_Click()
Dim chuoi, chuoimoi, congty, gdv As String
Dim i, j As Integer

'==== chuyen bien so sang format chung
chuoi = UCase(txtbks.Text)
chuoimoi = ""

For i = 1 To Len(chuoi)
If Mid(chuoi, i, 1) <> "-" And Mid(chuoi, i, 1) <> "." And Mid(chuoi, i, 1) <> "_" Then
chuoimoi = chuoimoi + Mid(chuoi, i, 1)
End If
Next i

If Len(chuoimoi) = 8 Then
chuoimoi = Left(chuoimoi, 3) + "-" + Mid(chuoimoi, 4, 3) + "." + Right(chuoimoi, 2)
Else
chuoimoi = Left(chuoimoi, 3) + "-" + Right(chuoimoi, 4)
End If
'=====================================
congty = UNItoVBA(txtcongty.Value)
' congty = "C" & ChrW(212) & "NG TY B" & ChrW(7842) & "O HI" & ChrW(7874) & "M NGH" & ChrW(7878) & " AN"
gdv = "Gi" & ChrW(225) & "m " & ChrW(273) & ChrW(7883) & "nh vi" & ChrW(234) & "n: "


ActiveWindow.View = xlPageLayoutView
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""Times New Roman,Bold""&12" & congty _
& Chr(10) & "&""Times New Roman,Regular""&12" & gdv _
' & Chr(10) & "&""Times New Roman,Regular""&12 Ngay giam dinh: " & "20/12/2017 BKS: "
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
Application.PrintCommunication = True
Range("A1").Select

'===========================================================


With Sheets("Data")

.Range("A3") = txtcongty.Text

.Range("A4") = txtgdv.Text
.Range("A5") = txtnggd.Text
.Range("A6") = chuoimoi
.Range("A7") = txtanhdau.Text
.Range("A8") = txtanhcuoi.Text
.Range("A9") = UNItoVBA(txtcongty.Text)

End With

UserForm1.Hide
End Sub
'=====================================================
'Chuyen chuoi tu UNICODE sang Code VBA
Function UNItoVBA(ByVal MyStr As String) As String

Dim Str As String, i As Integer, CStart As Integer, CCount As Integer, Status As Boolean
Str = "-225-224-7843-227-7841-259-7855-7857-7859-7861-7863-226-7845-7847-7849-7851-7853-273-233-232-7867-7869-7865-234-7871-7873-7875-7877-7879-237-236-7881-297-7883-243-242-7887-245-7885-244-7889-7891-7893-7895-7897-417-7899-7901-7903-7905-7907-250-249-7911-361-7909-432-7913-7915-7917-7919-7921-253-7923-7927-7929-7925-193-192-7842-195-7840-258-7854-7856-7858-7860-7862-194-7844-7846-7848-7850-7852-272-201-200-7866-7868-7864-202-7870-7872-7874-7876-7878-205-204-7880-296-7882-211-210-7886-213-7884-212-7888-7890-7892-7894-7896-416-7898-7900-7902-7904-7906-218-217-7910-360-7908-431-7912-7914-7916-7918-7920-221-7922-7926-7928-7924-10-"
For i = 1 To Len(MyStr)
If InStr(Str, "-" & AscW(Mid(MyStr, i, 1)) & "-") = 0 Then
If Not Status Then
CStart = i: Status = True
End If
CCount = CCount + 1
Else
If Status Then UNItoVBA = UNItoVBA & IIf(UNItoVBA = "", "", " & ") & """" & Replace(Mid(MyStr, CStart, CCount), """", """""") & """"
Status = False
CCount = 0
UNItoVBA = UNItoVBA & IIf(UNItoVBA = "", "", " & ") & "ChrW(" & AscW(Mid(MyStr, i, 1)) & ")"
End If
Next
If Status Then UNItoVBA = UNItoVBA & IIf(UNItoVBA = "", "", " & ") & """" & Replace(Mid(MyStr, CStart, CCount), """", """""") & """"
End Function

Private Sub Label1_Click()
End Sub
=========================
Em bị lỗi ở đây: nếu dùng congty = UNItoVBA(txtcongty.Value) thì không ra. nếu dùng congty = "C" & ChrW(212) & "NG TY B" & ChrW(7842) & "O HI" & ChrW(7874) & "M NGH" & ChrW(7878) & " AN" => ok.

congty = UNItoVBA(txtcongty.Value)
' congty = "C" & ChrW(212) & "NG TY B" & ChrW(7842) & "O HI" & ChrW(7874) & "M NGH" & ChrW(7878) & " AN"
gdv = "Gi" & ChrW(225) & "m " & ChrW(273) & ChrW(7883) & "nh vi" & ChrW(234) & "n: "
ActiveWindow.View = xlPageLayoutView
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = "&""Times New Roman,Bold""&12" & congty _
& Chr(10) & "&""Times New Roman,Regular""&12" & gdv _
' & Chr(10) & "&""Times New Roman,Regular""&12 Ngay giam dinh: " & "20/12/2017 BKS: "

 

[duytmd]

Nhờ a chị xem vì sao code bị lỗi "Compile error: User - defined type not defined.
Public Sub ShowDonGia()
FormDonGia.Show
End Sub

 

[Hoang2013]

Nhờ a chị xem vì sao code bị lỗi "Compile error: User - defined type not defined.
Public Sub ShowDonGia()
FormDonGia.Show
End Sub

Bạn kiểm xem có đối tượng nào có tên 'FormDonGia' hay chưa?

 

[duytmd]

Bạn kiểm xem có đối tượng nào có tên 'FormDonGia' hay chưa?

Cám ơn bạn, mình chỉnh được rồi

 

[ĐẶng thị Thanh Nhàn]

Chào cả nhà GPEX,

Mình chưa thạo code VBA nên khi chạy bị lỗi. Nó báo lỗi ở dòng mình bôi tím:
'Delete Empty Sheets
Application.DisplayAlerts = False
Sheets(J.Value).Delete
Application.DisplayAlerts = True

Các ACE xem giúp mình. Cảm ơn cả nhà nhiều ạ.

 

[thangteo]

Xin chuyển nội dung sang mục khác ạ.

 

[thaplang]

Cả nhà ơi cho mình hỏi vấn đề về mảng này với. Mình có 1 hàm loại bỏ các giá trị trùng trong mảng sau khi mình dùng hàm function xong thì mình quay trở lại gán nó vào 1 biến Vdata1 (Variant) thì nó báo lỗi của mình Type mismatch (Run time Error 13) Do mình mới học nên chưa rõ lắm mong mọi người chỉ giáo thêm ạ CÁM ƠN

Function RemoveDuplicatesVariant(DataArr As Variant) As Variant
    Dim newArr()
    Dim dupArrIndex As Integer, i As Integer, j As Integer
    Dim dupBool As Boolean
    dupArrIndex = -1
    For i = LBound(DataArr) To UBound(DataArr)
        dupBool = True
        For j = LBound(DataArr) To i
            If DataArr(i, 1) = DataArr(j, 1) And (DataArr(i, 4) = DataArr(j, 4)) And Not i = j Then
            dupBool = False
            End If
        Next j
        If dupBool = True Then
            dupArrIndex = dupArrIndex + 1
            ReDim Preserve newArr(dupArrIndex)
            newArr(dupArrIndex) = Array(DataArr(i, 1), DataArr(i, 4))
        End If
    Next i
    RemoveDuplicatesVariant = newArr
End Function

Sub RemoveDupicates()
    Dim iLastRowRider As Integer, iLastRowDate As Integer
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim rDate As Range
    Dim vDate As Variant
    Dim vDate1 As Variant
    Dim Data As Worksheet, test As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Data = wb.Sheets("Data")
    Set test = wb.Sheets("Test")
    
    
    'Lay ngay
     test.Range("A4:A1048576").ClearContents
    iLastRowDate = Data.Range("B" & Rows.Count).End(xlUp).Row
    Set rDate = Data.Range("B2:E" & iLastRowDate)
    Set vDate = rDate

    
    Set vDate1 = RemoveDuplicatesVariant(vDate.Value2) 'Bị báo lỗi
  MsgBox (vDate1.Rows.Count)
End Sub