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

sky_hungnguyen

Thành viên mới
Tham gia ngày
15 Tháng năm 2013
Bài viết
1
Được thích
0
Điểm
0
Tuổi
27
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??
Cảm ơn!
 

Loannie

Thành viên mới
Tham gia ngày
22 Tháng chín 2009
Bài viết
30
Được thích
1
Điểm
0
Tuổi
32
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!
 

File đính kèm

chitbk

Thành viên mới
Tham gia ngày
11 Tháng hai 2009
Bài viết
7
Được thích
0
Điểm
663
Tuổi
34
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ị
upload_2017-11-30_15-21-48.png sau khi Enter từng Ô thì upload_2017-11-30_15-22-19.png
 

Đặng Anh Khoa

Thành viên mới
Tham gia ngày
21 Tháng tám 2017
Bài viết
5
Được thích
1
Điểm
0
Tuổi
25
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

Thành viên mới
Tham gia ngày
29 Tháng chín 2006
Bài viết
3
Được thích
0
Điểm
0
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

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,815
Được thích
4,063
Điểm
860
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ổ
Mã:
.to = "huynhnguyenbinh@gmail.com"
thành
Mã:
.to = [A20]
thử xem.
 

keke355992

Thành viên thường trực
Tham gia ngày
19 Tháng một 2008
Bài viết
310
Được thích
20
Điểm
685
Tuổi
32
Nơi ở
Hoà Bình
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

Thành viên mới
Tham gia ngày
19 Tháng bảy 2008
Bài viết
8
Được thích
0
Điểm
663
Tuổi
38
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: "
 

File đính kèm

duytmd

Thành viên chính thức
Tham gia ngày
28 Tháng bảy 2010
Bài viết
78
Được thích
2
Điểm
370
Tuổi
39
Nhờ a chị xem vì sao code bị lỗi "Compile error: User - defined type not defined.
Public Sub ShowDonGia()
FormDonGia.Show
End Sub
 
Lần chỉnh sửa cuối:

ĐẶng thị Thanh Nhàn

Thành viên mới
Tham gia ngày
24 Tháng năm 2009
Bài viết
2
Được thích
0
Điểm
0
Tuổi
32
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 ạ.
 

File đính kèm

thangteo

Thành viên thường trực
Tham gia ngày
8 Tháng năm 2007
Bài viết
381
Được thích
43
Điểm
685
Tuổi
33
Xin chuyển nội dung sang mục khác ạ.
 
Lần chỉnh sửa cuối:

thaplang

Thành viên mới
Tham gia ngày
11 Tháng tám 2011
Bài viết
6
Được thích
2
Điểm
365
Tuổi
29
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
Mã:
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
Mã:
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
 

thangteo

Thành viên thường trực
Tham gia ngày
8 Tháng năm 2007
Bài viết
381
Được thích
43
Điểm
685
Tuổi
33
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
Mã:
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
Mã:
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
Thường thì lỗi mismatch là lỗi không tương đồng giữa kiểu biến đã khai báo với kiểu giá trị biến vừa gán.
 

thaplang

Thành viên mới
Tham gia ngày
11 Tháng tám 2011
Bài viết
6
Được thích
2
Điểm
365
Tuổi
29
Mình có 1 thắc mắc là mình muốn filter nhưng giá trị lớn hơn 3 trong mảng thì phải làm sao ạ mình có thể dùng hàm Filter được không còn hàm dưới thì chỉ trả cho mình tới 2 giá trị đó là 1,10 mình cám ơn
Mã:
Sub FilterArray()
 Dim a,b As Variant
a =Array(1,2,3,4,5,6,7,8,9,10)
b= Filter(a,1)
For each x In b
  MsgBox(x)
Next
 

hoanganhvo2612

Thành viên hoạt động
Tham gia ngày
15 Tháng mười một 2016
Bài viết
146
Được thích
61
Điểm
180
Mình có 1 thắc mắc là mình muốn filter nhưng giá trị lớn hơn 3 trong mảng thì phải làm sao ạ mình có thể dùng hàm Filter được không còn hàm dưới thì chỉ trả cho mình tới 2 giá trị đó là 1,10 mình cám ơn
Mã:
Sub FilterArray()
 Dim a,b As Variant
a =Array(1,2,3,4,5,6,7,8,9,10)
b= Filter(a,1)
For each x In b
  MsgBox(x)
Next
Bỏ filter đi, chỉ cần for next là đủ
for i = 1 to ubound(a)
if a(i) > 3 then msgbox(a(i))
Next
 

HieuCD

Thành viên gạo cội
Tham gia ngày
14 Tháng chín 2010
Bài viết
6,079
Được thích
11,183
Điểm
1,560
Mình có 1 thắc mắc là mình muốn filter nhưng giá trị lớn hơn 3 trong mảng thì phải làm sao ạ mình có thể dùng hàm Filter được không còn hàm dưới thì chỉ trả cho mình tới 2 giá trị đó là 1,10 mình cám ơn
Mã:
Sub FilterArray()
 Dim a,b As Variant
a =Array(1,2,3,4,5,6,7,8,9,10)
b= Filter(a,1)
For each x In b
  MsgBox(x)
Next
Mã:
Sub FilterArray()
  Dim a As Variant
  a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
  For Each i In a
    For Each x In Filter(a, i)
      MsgBox (x)
    Next
  Next
End Sub
 

thaplang

Thành viên mới
Tham gia ngày
11 Tháng tám 2011
Bài viết
6
Được thích
2
Điểm
365
Tuổi
29
Cho mình hỏi xí về hàm Countifs trong VBA với minh có tiềm hiểu trên Internet về hàm Countifs như thế này
Mã:
[COUNTIFS(Data!E2:E1048576,Test!B4,Data!B2:B1048576,Test!A4,Data!J2:J1048576,"<>"&"")]
nhưng mình muốn sửa lại thành
Mã:
Dim a as Integer, row as Integer
a=1
row = Data.Range("B" &Rows.Count).End(xlUp.Row)

test.Range("C1").Value = [COUNTIFS(Data!E2:E row, Test!B & a ,Data!B2:B row,Test!A & a,Data!J2:J row,"<>"&"")]
được không ạ mình cám ơn rất nhiều
 
Top Bottom