Chuyên đề giải đáp những thắc mắc về code VBA (3 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 3 (Thành viên: 0, Khách: 3)
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
Đặng Anh Khoa đã viết:
Em phải làm sao để HKNK được hiểu là chuổi cần tìm mà ko phải là biến, để ô A1 trả về True.
Nhấp chuột vào đây để mở rộng...
Bật chức năng Record macro lên để ghi lại quá trình bạn viết công thức là có kết quả.
PHP: 
Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveCell.FormulaR1C1 = "=ISNUMBER(FIND(""HKNK"",RC[1]))"
    Range("A2").Select
End Sub
 
Upvote 0
Anh Befaint cho em hỏi chút ạ! sub này của em chạy vẫn ổn, khi cho vào form báo lỗi như dưới đây là sao ạ
Sub hidedongproKL()
Dim headRowHei As Double, pageHei As Double, tRowHei As Double, shNames As Range
Dim ws As Worksheet, r As Long, lrPrint As Long, arr As Variant, lrCT As Long, frCT As Long, signRow As Long

Application.ScreenUpdating = False

Set ws = ActiveSheet
With ws
ws.Activate
lrPrint = .[B65000].End(xlUp).row
.Range("B1:B" & lrPrint).EntireRow.Hidden = False
arr = .Range("B1:D" & lrPrint).Value
For r = UBound(arr) To 1 Step -1
If WorksheetFunction.Trim(arr(r, 1)) <> "" And Not IsNumeric(arr(r, 1)) Then signRow = r
If Val(arr(r, 1)) <> 0 Or Val(arr(r, 3)) <> 0 Then
lrCT = r
Exit For
End If
Next
frCT = .Rows(.PageSetup.PrintTitleRows).row + .Rows(.PageSetup.PrintTitleRows).Rows.Count
.Rows(frCT & ":" & lrPrint).RowHeight = 18 'Chieu tao toi thieu cua dong`
If lrCT < signRow - 1 Then
.Rows((lrCT + 1) & ":" & (signRow - 1)).Hidden = True
End If
Nhấp chuột vào đây để mở rộng...
[QUOTE="befaint, [/QUOTE]
 
Upvote 0
Bạn đang thiếu dòng lệnh
End With

Mà mình thấy ngộ chổ này:
PHP: 
Set ws = ActiveSheet
With ws
   ws.Activate
Hình như câu lệnh cuối là thừa.
Diều này chứng tỏ (có thể) bạn chưa dịch sang tiếng Việt (để hiểu) các dòng lệnh này.
 
Upvote 0
Anh Nghĩa cho em hỏi, làm sao để update một listview mà vẫn giữ được scroll view hiện thời? Cám ơn anh.
 
Upvote 0
SA_DQ đã viết:
Bạn đang thiếu dòng lệnh
End With

Mà mình thấy ngộ chổ này:
PHP: 
Set ws = ActiveSheet
With ws
   ws.Activate
Hình như câu lệnh cuối là thừa.
Diều này chứng tỏ (có thể) bạn chưa dịch sang tiếng Việt (để hiểu) các dòng lệnh này.
Nhấp chuột vào đây để mở rộng...
Chỗ kia sửa thành worksheet.active luôn anh nhỉ
- file đây anh xem hộ em với
 

File đính kèm

Upvote 0
1./ Bạn nên bắt đầu các câu lệnh 1 cách thẳng cột; Các câu lệnh như thế này là bạn bắt chước ai vậy:
PHP: 
Sub hidedongproKL()
    Dim headRowHei As Double, pageHei As Double, tRowHei As Double, shNames As Range
    Dim ws As Worksheet, r As Long, lrPrint As Long, arr As Variant, lrCT As Long, frCT As Long, signRow As Long

    Application.ScreenUpdating = False
 
Set ws = ActiveSheet
        With ws
            ws.Activate
            lrPrint = .[B65000].End(xlUp).row
            MsgBox lrPrint
            .Range("B1:B" & lrPrint).EntireRow.Hidden = False
            arr = .Range("B1:D" & lrPrint).Value
            For r = UBound(arr) To 1 Step -1
                If WorksheetFunction.Trim(arr(r, 1)) <> "" And Not IsNumeric(arr(r, 1)) Then signRow = r
                If Val(arr(r, 1)) <> 0 Or Val(arr(r, 3)) <> 0 Then
                    lrCT = r
                    Exit For
                End If
            Next
& kiểu như vậy có giúp gì cho bạn trong chuyện fát hiện ra lỗi sơ đẵng hay không, như Có If mà không có End If,. . . .

2./ Cứ cho là giữa fần khai báo các biến & fần các câu lệnh thừa hành nên có dòng trống để tiện fân biệt;
Nhưng sau dòng trống đó 1 dòng lý gì có dòng trống thứ 2?

3./ Câu lệnh ws.Activate là thừa. Nên bỏ đi;

4./ Nên chăng các dòng khai báo biến nên có cùng loại
Không nên:
Dim GPE As Byte, Rng As Range
Dim Rws As Long, Wh As Worksheet

5./ Câu lệnh này mình thấy báo lỗi:
PHP: 
frCT = .Rows(.PageSetup.PrintTitleRows).row + .Rows(.PageSetup.PrintTitleRows).Rows.Count

Bạn kiểm tra xem các tham biến tại thời điểm báo lỗi có trị là bao nhiêu?
(Có thể) do máy của mình không có máy in, nên nó báo là
.PageSetup.PrintTitleRows =""

Tạm thời là vậy; Có gì các bạn khác sẽ giúp bạn tiếp!
 
Upvote 0
ChanhTQ@ đã viết:
1./ Bạn nên bắt đầu các câu lệnh 1 cách thẳng cột; Các câu lệnh như thế này là bạn bắt chước ai vậy:
PHP: 
Sub hidedongproKL()
    Dim headRowHei As Double, pageHei As Double, tRowHei As Double, shNames As Range
    Dim ws As Worksheet, r As Long, lrPrint As Long, arr As Variant, lrCT As Long, frCT As Long, signRow As Long

    Application.ScreenUpdating = False
 
Set ws = ActiveSheet
        With ws
            ws.Activate
            lrPrint = .[B65000].End(xlUp).row
            MsgBox lrPrint
            .Range("B1:B" & lrPrint).EntireRow.Hidden = False
            arr = .Range("B1:D" & lrPrint).Value
            For r = UBound(arr) To 1 Step -1
                If WorksheetFunction.Trim(arr(r, 1)) <> "" And Not IsNumeric(arr(r, 1)) Then signRow = r
                If Val(arr(r, 1)) <> 0 Or Val(arr(r, 3)) <> 0 Then
                    lrCT = r
                    Exit For
                End If
            Next
& kiểu như vậy có giúp gì cho bạn trong chuyện fát hiện ra lỗi sơ đẵng hay không, như Có If mà không có End If,. . . .

2./ Cứ cho là giữa fần khai báo các biến & fần các câu lệnh thừa hành nên có dòng trống để tiện fân biệt;
Nhưng sau dòng trống đó 1 dòng lý gì có dòng trống thứ 2?

3./ Câu lệnh ws.Activate là thừa. Nên bỏ đi;

4./ Nên chăng các dòng khai báo biến nên có cùng loại
Không nên:
Dim GPE As Byte, Rng As Range
Dim Rws As Long, Wh As Worksheet

5./ Câu lệnh này mình thấy báo lỗi:
PHP: 
frCT = .Rows(.PageSetup.PrintTitleRows).row + .Rows(.PageSetup.PrintTitleRows).Rows.Count

Bạn kiểm tra xem các tham biến tại thời điểm báo lỗi có trị là bao nhiêu?
(Có thể) do máy của mình không có máy in, nên nó báo là
.PageSetup.PrintTitleRows =""

Tạm thời là vậy; Có gì các bạn khác sẽ giúp bạn tiếp!
Nhấp chuột vào đây để mở rộng...
3. Set ws = ActiveSheet
With ws
ws.Activate
-----> thay luôn bằng worksheet.active anh nhỉ
4. Khai báo như thế cũng chỉ là lệnh tắt thôi nhỉ anh: không nên
5. trong code thêm: lại chạy được anh à
Sheets("1.KL V").Select
hidedongproKL
Sheets("1.KL V").Range("J8").Value = I
Sheets("1.KL V").PrintOut
 
Upvote 0
Chào anh Vova2209! Anh cho em hỏi, em tạo một listview nhiều cột, chỉ hiện thị một lúc được 10 cột, muốn xem cột nào thì mình kéo scroll bar nằm ngang đến cột đó. Vậy có code nào để tự động dịch scroll bar đến cột mình cần không anh?
 
Upvote 0
PHANPHUOCDINH đã viết:
Chào anh Vova2209! Anh cho em hỏi, em tạo một listview nhiều cột, chỉ hiện thị một lúc được 10 cột, muốn xem cột nào thì mình kéo scroll bar nằm ngang đến cột đó. Vậy có code nào để tự động dịch scroll bar đến cột mình cần không anh?
Nhấp chuột vào đây để mở rộng...
Bạn ơi! nếu nhiều cột nó sẽ tự động thêm thanh quận ngang cho mình mà, không phải code đâu!
 
Upvote 0
vova2209 đã viết:
Bạn ơi! nếu nhiều cột nó sẽ tự động thêm thanh quận ngang cho mình mà, không phải code đâu!
Nhấp chuột vào đây để mở rộng...

Dạ, em biết là có thành scroll bar nằm ngang để kéo đến cột cần xem, nhưng em muốn khi mở form, thì listview tự động kéo đến cột chứa dữ liệu cuối cùng, như vậy thì phải viết code như thế nào vậy anh?
 
Upvote 0
Em có sưu tập được code sau dùng để hiện màu cột, dòng căn cứ vào vị trí con chuột trong excel (dòng và cột cắt nhau tại vị trí này):

PHP: 
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Update 20140318
Static xRow
Static xColumn
If xColumn <> "" Then
    With Columns(xColumn).Interior
        .ColorIndex = xlNone
    End With
    With Rows(xRow).Interior
        .ColorIndex = xlNone
    End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn).Interior
    .ColorIndex = 6
    .Pattern = xlSolid
End With
With Rows(pRow).Interior
    .ColorIndex = 6
    .Pattern = xlSolid
End With
End Sub

Hiện tại nó sẽ hiện màu toàn bộ ô trong dòng và cột. Có các nào khống chế số ô và dòng này bằng một con số nhất định được không anh chị. Ví dụ chỉ cho phép hiện màu trong vùng (A1:H5000) được không mọi người?
 
Upvote 0
Bạn thử với cái này:
PHP: 
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Sub GPE()
Update 20140318 '
Const Hg As Long = 50:            Const Cot As Integer = 23
Static xRow
Static xColumn

xRow = Selection.Row:               xColumn = Selection.Column
With Cells(1, xColumn).Resize(Hg).Interior
    .ColorIndex = 7:                .Pattern = xlSolid
End With
With Cells(xRow, 1).Resize(, Cot).Interior
    .ColorIndex = 7:                .Pattern = xlSolid
End With
End Sub

Sau đó tự sửa lại các tham số cần thiết.
 
Upvote 0
ChanhTQ@ đã viết:
Bạn thử với cái này:
PHP: 
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Sub GPE()
Update 20140318 '
Const Hg As Long = 50:            Const Cot As Integer = 23
Static xRow
Static xColumn

xRow = Selection.Row:               xColumn = Selection.Column
With Cells(1, xColumn).Resize(Hg).Interior
    .ColorIndex = 7:                .Pattern = xlSolid
End With
With Cells(xRow, 1).Resize(, Cot).Interior
    .ColorIndex = 7:                .Pattern = xlSolid
End With
End Sub

Sau đó tự sửa lại các tham số cần thiết.
Nhấp chuột vào đây để mở rộng...

Cảm ơn anh ạ, em xin phép bổ sung thêm.

PHP: 
If xColumn <> "" Then
    With Columns(xColumn).Interior
        .ColorIndex = xlNone
    End With
    With Rows(xRow).Interior
        .ColorIndex = xlNone
    End With
End If
...
 
Upvote 0
Mục đích bạn đưa mấy dòng lệnh này vô macro để làm gì vậy? Có thể cho biết được không nếu thấy không fiền?!
 
Upvote 0
ChanhTQ@ đã viết:
Mục đích bạn đưa mấy dòng lệnh này vô macro để làm gì vậy? Có thể cho biết được không nếu thấy không fiền?!
Nhấp chuột vào đây để mở rộng...

Anh viết code chạy ngon lành mà không cần biết nó làm gì, giỏi thật. Cái này em hay nhập giấy nghỉ các loại theo từng cột ngày. Nhập rất nhiều sợ người lọ lẫn vào người kia nên em làm cái này để bấm vào người nào thì hiện màu dòng của người đó anh ạ :)

Dòng lệnh em thêm để nó bỏ màu đi nếu di chuyển sang các ô khác anh ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
Thì mình thấy lạ ở chỗ là tham biến xColumn vừa khai báo ngay dòng trước đó;
Hiển nhiên tại dòng lệnh điều kiện
Mã: 
If xColumn <> "" Then
Nó nhận trị rỗng hay bằng 0 gì đó; Nên câu hỏi mầy giống cái gì thì tham biến này làm sao nó trả lời!?!
 
Upvote 0
ChanhTQ@ đã viết:
Thì mình thấy lạ ở chỗ là tham biến xColumn vừa khai báo ngay dòng trước đó;
Hiển nhiên tại dòng lệnh điều kiện
Mã: 
If xColumn <> "" Then
Nó nhận trị rỗng hay bằng 0 gì đó; Nên câu hỏi mầy giống cái gì thì tham biến này làm sao nó trả lời!?!
Nhấp chuột vào đây để mở rộng...

Chắc nó liên quan cái Static. Bài đầu em bảo code sưu tầm mà chứ em có viết ra nó đâu anh :D
 
Upvote 0
Sưu tầm nhưng fải có chọn lọc; Có thế mới đúng theo chủ trương & nghị quyết đó nha!

Chúc vui!
 
Upvote 0
ChanhTQ@ đã viết:
Sưu tầm nhưng fải có chọn lọc; Có thế mới đúng theo chủ trương & nghị quyết đó nha!

Chúc vui!
Nhấp chuột vào đây để mở rộng...

Vì nếu không có đoạn đó thì khi di chuyển con trỏ chuột sang ô khác (giống như hành quân sang vị trí khác nhưng không thu dọn bãi chiến trường anh ạ).
 
Upvote 0
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.
 
Upvote 0
tueyennhi đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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...)
 
Upvote 0
Hai Lúa Miền Tây đã viết:
Là sao bạn?
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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?
 
Upvote 0
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!
 
Upvote 0
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!
 
Upvote 0
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

Upvote 0
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
 
Upvote 0
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 ạ.
 
Upvote 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
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
xitrum đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Bạn sửa chổ
Mã: 
.to = "huynhnguyenbinh@gmail.com"
thành
Mã: 
.to = [A20]
thử xem.
 
Upvote 0
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 ?
 
Upvote 0
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

Upvote 0
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:
Upvote 0
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

Upvote 0
Xin chuyển nội dung sang mục khác ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
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
 
Upvote 0
thaplang đã viết:
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
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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
 
Upvote 0
thaplang đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bỏ filter đi, chỉ cần for next là đủ
for i = 1 to ubound(a)
if a(i) > 3 then msgbox(a(i))
Next
 
Upvote 0
thaplang đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
 
Upvote 0
Các bác, các anh chị và các bạn giúp đỡ em về bài này với ạ.
Em có 1 bảng như trong file đính kèm.
Yêu cầu đặt ra như sau: Nhập vào số lượng nhập và số lượng xuất sau đó tính số lượng còn lại.
Nếu số lượng còn lại = 0 thì tô vàng vùng chứa số liệu trong dòng đó còn nếu nhỏ hơn 0 thì chỉ tô màu ô ở cột 5 dòng đó.
Và nếu số lượng xuất bằng rỗng thì để trắng cả dòng đó.
Ví dụ: C2 = 100, nếu D2 = 100 thì tô màu vàng vùng A2:E2, nếu D2 <100 thì tô màu đỏ ô E2 và D2="" thì để trắng vùng A2:E2
Em có viết code VBA như sau nhưng bị lỗi mọi người kiểm tra giúp em với ạ.
Mã: 
Dim i As Integer
Dim Vung As Range
Sheets("sheet1").Select
Range("C2").Select
For i = 2 To 11
    If Cells(i, 3) <> Empty Then
        Cells(i, 5).Value = Cells(i, 3).Value - Cells(i, 4).Value
        If Cells(i, 5) = 0 Then
            Set Vung = Range(Cells(i, 1), Cells(i, 5))
            Range("Vung").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Else
            Cells(i, 5).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
         End If
      Else
      Cells(i, 5).Value = Empty
       End If
Next i
 
Upvote 0
Tiếc là không mở được file của bạn; Nó báo lỗi định dạng file sao đó.
 
Upvote 0
Em có 1 file này mà khi em chạy VBA thì dữ liệu ở cột Subtype ( màu xanh ) nó mất luôn. Các anh sửa hộ em vẫn giữ được dữ liệu ở các ô xen kẽ như ví dụ được không. Em cám ơn.
 

File đính kèm

Upvote 0
bigbabol89 đã viết:
Em có 1 file này mà khi em chạy VBA thì dữ liệu ở cột Subtype ( màu xanh ) nó mất luôn. Các anh sửa hộ em vẫn giữ được dữ liệu ở các ô xen kẽ như ví dụ được không. Em cám ơn.
Nhấp chuột vào đây để mở rộng...
Trong Code của bạn không có dArr(K, 4) nên nó vậy
 
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Trong Code của bạn không có dArr(K, 4) nên nó vậy
Nhấp chuột vào đây để mở rộng...
Anh ơi, em biết ít về VBA lắm, sửa như nào anh sửa hộ em được không ạ ?
Mã: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, C As Long, R As Long
With Sheets("Roster")
    C = .Range("F2") - .Range("C2") + 6
    sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R * C, 1 To 5)
End With
For I = 5 To R Step 5
    If sArr(I, 1) <> Empty Then
        For J = 6 To C
        K = K + 1
            dArr(K, 1) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(1, J)
            dArr(K, 5) = sArr(I, J)
        Next J
    End If
Next I
With Sheets("IT2003")
    Range("A2").Resize(100000, 5).ClearContents
    If K Then .Range("A2").Resize(K, 5) = dArr
End With
End Sub
 
Upvote 0
bigbabol89 đã viết:
Anh ơi, em biết ít về VBA lắm, sửa như nào anh sửa hộ em được không ạ ?
Mã: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, C As Long, R As Long
With Sheets("Roster")
    C = .Range("F2") - .Range("C2") + 6
    sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R * C, 1 To 5)
End With
For I = 5 To R Step 5
    If sArr(I, 1) <> Empty Then
        For J = 6 To C
        K = K + 1
            dArr(K, 1) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(1, J)
            dArr(K, 5) = sArr(I, J)
        Next J
    End If
Next I
With Sheets("IT2003")
    Range("A2").Resize(100000, 5).ClearContents
    If K Then .Range("A2").Resize(K, 5) = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn không khai báo dArr(k,4) thì hệ thống tự hiểu cột số 4 (Sub type) là trống.
Nếu muốn người khác sửa cho, bạn phải cho biết dữ liệu bạn muốn có là gì chứ?
 
Upvote 0
vanthinh3101 đã viết:
Bạn không khai báo dArr(k,4) thì hệ thống tự hiểu cột số 4 (Sub type) là trống.
Nếu muốn người khác sửa cho, bạn phải cho biết dữ liệu bạn muốn có là gì chứ?
Nhấp chuột vào đây để mở rộng...
Em chỉ muốn ô đó là ô trống, em tự điền. Nhưng khi em chạy code thì dữ liệu em đã điền bị xóa luôn. Ý là cột 1,2,3 là fill dữ liệu từ code, bỏ cột 4 ( tự điền ), fill cột 5 fill dữ liệu từ code
 
Upvote 0
bigbabol89 đã viết:
Em chỉ muốn ô đó là ô trống, em tự điền. Nhưng khi em chạy code thì dữ liệu em đã điền bị xóa luôn. Ý là cột 1,2,3 là fill dữ liệu từ code, bỏ cột 4 ( tự điền ), fill cột 5 fill dữ liệu từ code
Nhấp chuột vào đây để mở rộng...
Bạn xem đúng ý không.
Mã: 
Public Sub GPE()
    Dim sArr(), dArr1(), dArr2(), I As Long, J As Long, K As Long, C As Long, R As Long
    With Sheets("Roster")
        C = .Range("F2") - .Range("C2") + 6
        sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
        R = UBound(sArr, 1)
        ReDim dArr1(1 To R * C, 1 To 3): ReDim dArr2(1 To R * C, 1 To 1)
    End With
    For I = 5 To R Step 5
        If sArr(I, 1) <> Empty Then
            For J = 6 To C
                K = K + 1
                dArr1(K, 1) = sArr(I, 1)
                dArr1(K, 2) = sArr(1, J)
                dArr1(K, 3) = sArr(1, J)
                dArr2(K, 1) = sArr(I, J)
            Next J
        End If
    Next I
    With Sheets("IT2003")
        Range("A2").Resize(100000, 3).ClearContents
        Range("E2").Resize(100000).ClearContents
        If K Then .Range("A2").Resize(K, 3) = dArr1: .Range("E2").Resize(K, 1) = dArr2
    End With
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Bạn xem đúng ý không.
Mã: 
Public Sub GPE()
    Dim sArr(), dArr1(), dArr2(), I As Long, J As Long, K As Long, C As Long, R As Long
    With Sheets("Roster")
        C = .Range("F2") - .Range("C2") + 6
        sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
        R = UBound(sArr, 1)
        ReDim dArr1(1 To R * C, 1 To 3): ReDim dArr2(1 To R * C, 1 To 1)
    End With
    For I = 5 To R Step 5
        If sArr(I, 1) <> Empty Then
            For J = 6 To C
                K = K + 1
                dArr1(K, 1) = sArr(I, 1)
                dArr1(K, 2) = sArr(1, J)
                dArr1(K, 3) = sArr(1, J)
                dArr2(K, 1) = sArr(I, J)
            Next J
        End If
    Next I
    With Sheets("IT2003")
        Range("A2").Resize(100000, 3).ClearContents
        Range("E2").Resize(100000).ClearContents
        If K Then .Range("A2").Resize(K, 3) = dArr1: .Range("E2").Resize(K, 1) = dArr2
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Thành công mỹ mãn. Em cám ơn anh rất nhiều
 
Upvote 0
Hi cả nhà ạ
Mình có viết đoạn code về tìm kiếm trong Combobox như sau:

Dim i As Long
For i = 1 To Application.WorksheetFunction.CountA(Main.Range("F:F"))
If LCase(Left(Main.Cells(i, 1), 1)) = Me.ComboBox1 And Me.ComboBox1 <> "" Then
Me.ComboBox1.AddItem Main.Cells(i, 1)
End If
Next i
Me.ComboBox1.DropDown
With Me
.txtdi.Value = .ComboBox1.List(.ComboBox1.ListIndex, 1)
End With
End Sub

nhưng khi bấm seach thì không hiện ra như mong muốn, chỉ viết tìm kiếm được có một chữ đến 2 chữ cái chứ không viết nhiều được ạ, và viết xong không bấm nút xoá được.
Trong Combobox mình để có 2 cột
Mong cả nhà giúp đỡ ạ
 
Upvote 0
Cho mình hỏi code:
Mã: 
Range("$C$3:$C$1734").AutoFilter Field:=1, Criteria1:="*" & Range("C1").Value & "*", Operator:=xlFilterValues
Nghĩ là gì vậy
 
Upvote 0
Cho em hỏi đoạn code em viết này sao nó chậm thế, có cách nào cho nhanh hơn không ạ
 

File đính kèm

Upvote 0
Cho em hỏi nếu viết dưới dạng Application.WorsheetFunction để có thể dùng với nhiều dạng hàm khác thì không được ạ?
 
Upvote 0
FPT_online đã viết:
Cho em hỏi nếu viết dưới dạng Application.WorsheetFunction để có thể dùng với nhiều dạng hàm khác thì không được ạ?
Nhấp chuột vào đây để mở rộng...
Em đọc ở đâu đó không nhớ rõ nhưng nếu mà sử dụng Application.WorsheetFunction thì phải thêm gỡ lỗi nữa thì phải..Cái Áp pờ li ca ti on khác với cái Áp pờ li ca ti on guốc sít phăn thì phải.Ôi khó đi ..
 
Lần chỉnh sửa cuối:
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Em đọc ở đâu đó không nhớ rõ nhưng nếu mà sử dụng Application.WorsheetFunction thì phải thêm gỡ lỗi nữa thì phải..Cái Áp pờ li ca ti on khác với cái Áp pờ li ca ti on guốc sít phăn thì phải.Ôi khó đi ..
Nhấp chuột vào đây để mở rộng...
Dùng cái nào đi nữa đều phải chủ động bẫy lỗi, ví dụ với cái vlookup chẳng hạn, Application.WorsheetFunction khi không dò được thì phát sinh lỗi. Với application tuy không phát sinh lỗi thực thi, nhưng kết quả của nó là Na, vẫn phải bẫy trường hợp này, nếu không code cũng teo.
 
Upvote 0
truongvu317 đã viết:
Dùng cái nào đi nữa đều phải chủ động bẫy lỗi, ví dụ với cái vlookup chẳng hạn, Application.WorsheetFunction khi không dò được thì phát sinh lỗi. Với application tuy không phát sinh lỗi thực thi, nhưng kết quả của nó là Na, vẫn phải bẫy trường hợp này, nếu không code cũng teo.
Nhấp chuột vào đây để mở rộng...
Em không biết 1 tẹo tiếng anh nào. Nhưng google họ dịch như thế này
Mã: 
Thí dụ

Mã số:
Phạm vi ("A1") .Giá trị = Ứng dụng.WorksheetFunction.Vlookup (.....)
Nếu Vlookup không tìm thấy một kết quả phù hợp (# N / A khi được viết trong một ô)
Sau đó, mã của bạn ngừng chạy và bạn nhận được cửa sổ gỡ lỗi.

nếu bạn làm như thế này
Mã số:
x = Application.Vlookup (.....)
Nó không còn dừng lại với gỡ lỗi.
Thay vào đó, biến x được gán giá trị lỗi và mã tiếp tục chạy.
 
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Em không biết 1 tẹo tiếng anh nào. Nhưng google họ dịch như thế này
Mã: 
Thí dụ

Mã số:
Phạm vi ("A1") .Giá trị = Ứng dụng.WorksheetFunction.Vlookup (.....)
Nếu Vlookup không tìm thấy một kết quả phù hợp (# N / A khi được viết trong một ô)
Sau đó, mã của bạn ngừng chạy và bạn nhận được cửa sổ gỡ lỗi.

nếu bạn làm như thế này
Mã số:
x = Application.Vlookup (.....)
Nó không còn dừng lại với gỡ lỗi.
Thay vào đó, biến x được gán giá trị lỗi và mã tiếp tục chạy.
Nhấp chuột vào đây để mở rộng...
Bạn cứ thử đi, biết liền, những điều tớ nói hoàn toàn tương đồng với google dịch.
 
Upvote 0
Nói chung mình muốn hỏi làm sao vẫn dùng Application.WorksheetFunction thì có cách nào cho nhanh không đó, nếu bẫy lỗi thì bẫy thế nào mọi người góp ý giúp
 
Upvote 0

File đính kèm

Upvote 0
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Em đọc ở đâu đó không nhớ rõ nhưng nếu mà sử dụng Application.WorsheetFunction thì phải thêm gỡ lỗi nữa thì phải..Cái Áp pờ li ca ti on khác với cái Áp pờ li ca ti on guốc sít phăn thì phải.Ôi khó đi ..
Nhấp chuột vào đây để mở rộng...

Tôi đã từng viết bài nói về cái này rồi. Nhưng nếu bạn vẫn mù mờ về lỗi thì có lẽ là chưa đọc bài đó.

WorksheetFunction sẽ lăn cù nếu gặp lỗi. Đó là điều kiện của nó. Nếu muốn tránh ngủm thì cái nơi gọi nó phải bẫy lỗi. Code bẫy lỗi thường là "On Error...". Loại code này thì hầu hết mọi người học qua bậc trung VBA đều biết viết.

Khi gọi hàm thẳng qua Application thì bạn có thể coi như là bạn gọi qua lớp bao gián tiếp (wrapper function). Lớp bao này cũng gọi hàm WorksheetFunction nhưng nó thêm cái code bẫy lỗi cho bạn. Nếu hàm bị lỗi thì nó sẽ không tỏi mà trả về một trị Error. Trong trường hợp này, người ta xét trị trả về để biết nó thành công hay error, và nếu error thì là gì.
Ví dụ điển hình:
myVariant = Application.Match(tim, mangDo, 0)
If Not IsError(myVariant) Then ' đây là hàm match cho nên dùng IsNumeric cũng được
' myVariant là kết quả
Else
' sử lý error ở đây
' nhưng 99,99% trường hợp hàm match thì là do tìm không có cho nên cũng dễ biết
' 0,01% còn lại là do dữ liệu dỏm, ví dụ mảng chẳng phải là mảng
End If

Chú: thực ra giữa cách gọi trực tiếp và gián tiếp còn khác nhau ở một vài tính chất mặc định của tham số truyền vào. Nhưng cấp độ này rất cao, thú nhận rằng tôi cũng chỉ biết 1 vài trường hợp chứ chưa nắm hết.
 
Upvote 0
VetMini đã viết:
Tôi đã từng viết bài nói về cái này rồi. Nhưng nếu bạn vẫn mù mờ về lỗi thì có lẽ là chưa đọc bài đó.

WorksheetFunction sẽ lăn cù nếu gặp lỗi. Đó là điều kiện của nó. Nếu muốn tránh ngủm thì cái nơi gọi nó phải bẫy lỗi. Code bẫy lỗi thường là "On Error...". Loại code này thì hầu hết mọi người học qua bậc trung VBA đều biết viết.

Khi gọi hàm thẳng qua Application thì bạn có thể coi như là bạn gọi qua lớp bao gián tiếp (wrapper function). Lớp bao này cũng gọi hàm WorksheetFunction nhưng nó thêm cái code bẫy lỗi cho bạn. Nếu hàm bị lỗi thì nó sẽ không tỏi mà trả về một trị Error. Trong trường hợp này, người ta xét trị trả về để biết nó thành công hay error, và nếu error thì là gì.
Ví dụ điển hình:
myVariant = Application.Match(tim, mangDo, 0)
If Not IsError(myVariant) Then ' đây là hàm match cho nên dùng IsNumeric cũng được
' myVariant là kết quả
Else
' sử lý error ở đây
' nhưng 99,99% trường hợp hàm match thì là do tìm không có cho nên cũng dễ biết
' 0,01% còn lại là do dữ liệu dỏm, ví dụ mảng chẳng phải là mảng
End If

Chú: thực ra giữa cách gọi trực tiếp và gián tiếp còn khác nhau ở một vài tính chất mặc định của tham số truyền vào. Nhưng cấp độ này rất cao, thú nhận rằng tôi cũng chỉ biết 1 vài trường hợp chứ chưa nắm hết.
Nhấp chuột vào đây để mở rộng...
Dạ Cám ơn Thầy. Em cũng mới biết đến cái này ạ. Hôm trước em có đọc qua bài "Viết các UDF hiệu quả của VBA (Phần 2) - sử dụng các hàm Excel bên trong một UDF" họ nói WorksheetFunction tốc đọ nhanh hơn Thầy ạ
 
Upvote 0
Wrapper function nó có cái giá phải trả của nó. Chương trình phải kết nối wrapper và chạy 1 vài dòng code phụ - điển hình là code bẫy lỗi.

Tuy nhiên, nếu tôi không lầm thì trong mẫu code so sánh của bài trên, người ta không có bẫy lỗi. Vì vậy, sự so sánh chỉ trên lý thuyết.
Trên thực tế, code bẫy lỗi của worksheetfunction sẽ tăng nó lên 1 chút. Và bên application thì dùng variant cho nên cũng bị tăng lên một chút. (variant chậm hơn Long).
 
Upvote 0
VetMini đã viết:
Tôi đã từng viết bài nói về cái này rồi. Nhưng nếu bạn vẫn mù mờ về lỗi thì có lẽ là chưa đọc bài đó.

WorksheetFunction sẽ lăn cù nếu gặp lỗi. Đó là điều kiện của nó. Nếu muốn tránh ngủm thì cái nơi gọi nó phải bẫy lỗi. Code bẫy lỗi thường là "On Error...". Loại code này thì hầu hết mọi người học qua bậc trung VBA đều biết viết.

Khi gọi hàm thẳng qua Application thì bạn có thể coi như là bạn gọi qua lớp bao gián tiếp (wrapper function). Lớp bao này cũng gọi hàm WorksheetFunction nhưng nó thêm cái code bẫy lỗi cho bạn. Nếu hàm bị lỗi thì nó sẽ không tỏi mà trả về một trị Error. Trong trường hợp này, người ta xét trị trả về để biết nó thành công hay error, và nếu error thì là gì.
Ví dụ điển hình:
myVariant = Application.Match(tim, mangDo, 0)
If Not IsError(myVariant) Then ' đây là hàm match cho nên dùng IsNumeric cũng được
' myVariant là kết quả
Else
' sử lý error ở đây
' nhưng 99,99% trường hợp hàm match thì là do tìm không có cho nên cũng dễ biết
' 0,01% còn lại là do dữ liệu dỏm, ví dụ mảng chẳng phải là mảng
End If

Chú: thực ra giữa cách gọi trực tiếp và gián tiếp còn khác nhau ở một vài tính chất mặc định của tham số truyền vào. Nhưng cấp độ này rất cao, thú nhận rằng tôi cũng chỉ biết 1 vài trường hợp chứ chưa nắm hết.
Nhấp chuột vào đây để mở rộng...
Thì em mới nói là dùng cái nào cũng phải bẫy lỗi, dùng application thì biến gán phải là variant, nếu không có thể gây ra lỗi.
 
Upvote 0
Liệu có code như này không anh chị
Find("<>1", LookIn:=xlValues, LookAt:=xlWhole)
Em điền thì không thấy có tác dụng gì cả. Em muốn tìm giá trị khác 1
 
Upvote 0
Mọi Người Giúp Mình với:
Mình mới tìm hiểu VBA cho excel. Mình viết 1 hàm đơn giản tính đơn giá cước VC như này:

Mã: 
Public Function Don_gia(culi) As Double
' tính don giá cuoc Van chuyen Bê tông
bang_gia = Sheets(1).Ranges("E56:E65")
If culi <= 2 Then
Don_gia = Application.Index(bang_gia, 1)
Exit Function
ElseIf culi <= 5 Then
    Don_gia = Application.Index(bang_gia, 2)
    Exit Function
    ElseIf culi >= 41 Then
        Don_gia = Application.Index(bang_gia, 10)
        Exit Function
        Else: Don_gia = Application.Index(bang_gia, Application.RoundUp(culi / 5, 0))
End If

End Function
Ban đầu save nó yêu cầu save vào file Macro Enable lưu ngon lành ko báo lỗi gì, nhưng khi dùng thì kết quả toàn là #name .... giúp Mình Với.
 
Upvote 0
Khoakv.vp đã viết:
Mọi Người Giúp Mình với:
Mình mới tìm hiểu VBA cho excel. Mình viết 1 hàm đơn giản tính đơn giá cước VC như này:

Mã: 
Public Function Don_gia(culi) As Double
' tính don giá cuoc Van chuyen Bê tông
bang_gia = Sheets(1).Ranges("E56:E65")
If culi <= 2 Then
Don_gia = Application.Index(bang_gia, 1)
Exit Function
ElseIf culi <= 5 Then
    Don_gia = Application.Index(bang_gia, 2)
    Exit Function
    ElseIf culi >= 41 Then
        Don_gia = Application.Index(bang_gia, 10)
        Exit Function
        Else: Don_gia = Application.Index(bang_gia, Application.RoundUp(culi / 5, 0))
End If

End Function
Ban đầu save nó yêu cầu save vào file Macro Enable lưu ngon lành ko báo lỗi gì, nhưng khi dùng thì kết quả toàn là #name .... giúp Mình Với.
Nhấp chuột vào đây để mở rộng...
Gởi file và giải thích yêu cầu bạn muốn làm gì mới biết được.
 
Upvote 0
Khoakv.vp đã viết:
Mọi Người Giúp Mình với:
Mình mới tìm hiểu VBA cho excel. Mình viết 1 hàm đơn giản tính đơn giá cước VC như này:

Mã: 
Public Function Don_gia(culi) As Double
' tính don giá cuoc Van chuyen Bê tông
bang_gia = Sheets(1).Ranges("E56:E65")
If culi <= 2 Then
Don_gia = Application.Index(bang_gia, 1)
Exit Function
ElseIf culi <= 5 Then
    Don_gia = Application.Index(bang_gia, 2)
    Exit Function
    ElseIf culi >= 41 Then
        Don_gia = Application.Index(bang_gia, 10)
        Exit Function
        Else: Don_gia = Application.Index(bang_gia, Application.RoundUp(culi / 5, 0))
End If

End Function
Ban đầu save nó yêu cầu save vào file Macro Enable lưu ngon lành ko báo lỗi gì, nhưng khi dùng thì kết quả toàn là #name .... giúp Mình Với.
Nhấp chuột vào đây để mở rộng...
Bạn lưu file với tên và phần mở rộng là gì? Mở file để nhập công thức với tên và phần mở rộng là gì?
 
Upvote 0
Ba Tê đã viết:
Gởi file và giải thích yêu cầu bạn muốn làm gì mới biết được.
Nhấp chuột vào đây để mở rộng...
MÌnh muốn viết Hàm tính đơn giá cước vận chuyển biến là cự li vận chuyển, Bảng giá là Vùng dữ liệu trong bảng tính có đơn giá cho từng cự li.
Mọi người check code giúp mình xem code đúng không và sao kết quả là lỗi #name nhỉ ?
 
Upvote 0
Khoakv.vp đã viết:
Đây file đây ak. Giúp em nhé !
Nhấp chuột vào đây để mở rộng...
Do trùng tên module, ngoài ra còn bị lổi range
Mã: 
Public Function Don_gia1(culi) As Double
' tính don giá cuoc Van chuyen Bê tông
  Dim Bang_Gia As Range
  Set Bang_Gia = Sheets(1).Range("E56:E65")
  If culi <= 2 Then
      Don_gia1 = Application.Index(Bang_Gia, 1)
    ElseIf culi <= 5 Then
      Don_gia1 = Application.Index(Bang_Gia, 2)
    ElseIf culi >= 41 Then
      Don_gia1 = Application.Index(Bang_Gia, 10)
    Else
      Don_gia1 = Application.Index(Bang_Gia, Application.RoundUp(culi / 5, 0) + 1)
  End If
End Function
 
Upvote 0
Khoakv.vp đã viết:
Đây file đây ak. Giúp em nhé !
Nhấp chuột vào đây để mở rộng...
Sửa tên Module cho khác với tên Function.
Cho vào mảng gọn hơn.
PHP: 
Public Function Don_gia(Culy As Double) As Double
' tính don giá cuoc Van chuyen Bê tông
Dim Bang_gia()
Bang_gia = Sheets("Gia_cuoc").Range("E56:E65").Value
If Culy <= 2 Then
    Don_gia = Bang_gia(1, 1)
ElseIf Culy >= 41 Then
    Don_gia = Bang_gia(10, 1)
Else
    Don_gia = Bang_gia(Application.WorksheetFunction.RoundUp(Culy / 5, 0) + 1, 1)
End If
End Function
 

File đính kèm

Upvote 0
Ba Tê đã viết:
Sửa tên Module cho khác với tên Function.
Cho vào mảng gọn hơn.
PHP: 
Public Function Don_gia(Culy As Double) As Double
' tính don giá cuoc Van chuyen Bê tông
Dim Bang_gia()
Bang_gia = Sheets("Gia_cuoc").Range("E56:E65").Value
If Culy <= 2 Then
    Don_gia = Bang_gia(1, 1)
ElseIf Culy >= 41 Then
    Don_gia = Bang_gia(10, 1)
Else
    Don_gia = Bang_gia(Application.WorksheetFunction.RoundUp(Culy / 5, 0) + 1, 1)
End If
End Function
Nhấp chuột vào đây để mở rộng...
File của anh vẫn báo lỗi #NAME?
 
Upvote 0
Ba Tê đã viết:
Sửa tên Module cho khác với tên Function.
Cho vào mảng gọn hơn.
PHP: 
Public Function Don_gia(Culy As Double) As Double
' tính don giá cuoc Van chuyen Bê tông
Dim Bang_gia()
Bang_gia = Sheets("Gia_cuoc").Range("E56:E65").Value
If Culy <= 2 Then
    Don_gia = Bang_gia(1, 1)
ElseIf Culy >= 41 Then
    Don_gia = Bang_gia(10, 1)
Else
    Don_gia = Bang_gia(Application.WorksheetFunction.RoundUp(Culy / 5, 0) + 1, 1)
End If
End Function
Nhấp chuột vào đây để mở rộng...

Cảm ơn Bác nhiều nhé !
 
Upvote 0
2
HieuCD đã viết:
Do trùng tên module, ngoài ra còn bị lổi range
Mã: 
Public Function Don_gia1(culi) As Double
' tính don giá cuoc Van chuyen Bê tông
  Dim Bang_Gia As Range
  Set Bang_Gia = Sheets(1).Range("E56:E65")
  If culi <= 2 Then
      Don_gia1 = Application.Index(Bang_Gia, 1)
    ElseIf culi <= 5 Then
      Don_gia1 = Application.Index(Bang_Gia, 2)
    ElseIf culi >= 41 Then
      Don_gia1 = Application.Index(Bang_Gia, 10)
    Else
      Don_gia1 = Application.Index(Bang_Gia, Application.RoundUp(culi / 5, 0) + 1)
  End If
End Function
Nhấp chuột vào đây để mở rộng...

Bạn chỉ tham chiếu vào 1 ô của 1 range. Nếu dùng 1 biến tính ra ô này thì code dễ hiểu hơn

If culi <= 2 Then
oThamChieu = 1
ElseIf ....
...
End If
Don_gia1 = Sheets(1).Range("E56:E65").Cells(oThamChieu, 1).Value

Lưu ý là dùng cells sẽ tự động vượt ra khỏi range nếu oThamChieu > 10 (tức là khi trị culi > 50)
Nếu bạn muốn nó trả về lỗi khi vượt range thì dùng hàm index
Don_gia1 = Application.Index(Sheets(1).Range("E56:E65"), oThamChieu).Value
 
Upvote 0
Xin chào mọi người. Mình có thắc mắc về hàm
Function Filter2DArray(ByVal SourceArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean) của thầy @ndu96081631

Ở phần mình bôi đen, chỉ có thể tìm kiếm theo 1 cột và mình định trước. Giả dụ dữ liệu mình có 5 cột, Vậy có thể tìm kiếm, hoặc cột 1, hoặc cột 2 không
 
Upvote 0
Chào cả nhà, cho mình hỏi.
1. Mình sử dụng lệnh khai biến gì để khai biến một mãng mãng này có giá trị trong toàn bộ module. Mình vi dụ lấy mãng arr = range(A1:b1) và mãng này sử dụng trong module.
2. Mình có 1 mãng arr, sau khi dữ liệu đưa ra mãng sarr. Sau đó mình lấy arr = sarr. Cho mình hỏi như vậy có được không? và ảnh hưởng đến kết quả không? Xin cảm ơn
 
Upvote 0
chisinhvnn đã viết:
Chào cả nhà, cho mình hỏi.
1. Mình sử dụng lệnh khai biến gì để khai biến một mãng mãng này có giá trị trong toàn bộ module. Mình vi dụ lấy mãng arr = range(A1:b1) và mãng này sử dụng trong module.
2. Mình có 1 mãng arr, sau khi dữ liệu đưa ra mãng sarr. Sau đó mình lấy arr = sarr. Cho mình hỏi như vậy có được không? và ảnh hưởng đến kết quả không? Xin cảm ơn
Nhấp chuột vào đây để mở rộng...

1. Gồm 2 phần:
Phần thứ nhất thì rất dễ, chỉ cần đặt 1 lệnh sau ngay đầu Module:
Public arr
Phần thứ hai hơi rắc rối. Cần xác định rõ tầm vực sử dụng.

2. Nếu arr được Dim là mảng thì không thể được, nếu Dim là Variant thì được.
 
Upvote 0
PHP: 
Sub Min_vendor()
    Dim arr()
    Dim lastRow As Long, lastCol As Long, i As Long, j As Long, k As Long, Min As Long
    Cells.Interior.ColorIndex = no

    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    lasCol = Range("A" & Columns.Count).End(xlToLeft).Row

    MsgBox lastRow

    MsgBox lastCol

    For i = 5 To lastRow

        Min = Cells(i, 10)

        k = 10

        For j = 10 To lastCol - 3 Step 3

            If IsNumeric(Cells(i, j)) > 0 Then

                If Cells(i, j).Value2 < Min Then

                    Min = Cells(i, j)

                    k = j

                End If

            End If

        Next j

        Cells(i, k).Interior.Color = 49407

    Next i

End Sub

Cho em hỏi code tìm cột cuối cùng của em có gì sai mà chỉ báo là 0.
 
Upvote 0
Vâng code này em sưu tầm trên mạng. Vậy giờ em phải sửa như nào anh ơi?
 
Upvote 0
Ba Tê đã viết:
Muốn sửa thì phải thấy file và những yêu cầu làm việc gì, ra kết quả thế nào.
Code nó đã "tào lao" thì sao hiểu được cuối cùng nó ra cái gì.
Nhấp chuột vào đây để mở rộng...

Em muốn tìm giá trị Price nhỏ nhất của từng dòng rồi đổ màu vào ô đó. Anh xem file đính kèm cho em nhé, sao nghĩ thì đơn giản mà em làm mãi chẳng xong.
 

File đính kèm

Upvote 0
tueyennhi đã viết:
Em muốn tìm giá trị Price nhỏ nhất của từng dòng rồi đổ màu vào ô đó. Anh xem file đính kèm cho em nhé, sao nghĩ thì đơn giản mà em làm mãi chẳng xong.
Nhấp chuột vào đây để mở rộng...
bạn sửa lại lastrow từ cột A sang cột B xem thử. Chứ cột A dòng cuối 4 lấy đâu mà lặp
 
Upvote 0
tueyennhi đã viết:
Em muốn tìm giá trị Price nhỏ nhất của từng dòng rồi đổ màu vào ô đó. Anh xem file đính kèm cho em nhé, sao nghĩ thì đơn giản mà em làm mãi chẳng xong.
Nhấp chuột vào đây để mở rộng...
Thử chạy Sub này cho file trên của bạn xem sao, Không cần cột V.
PHP: 
Option Explicit

Sub Tim_Min_Price()
Dim I As Long, J As Long, Col As Long, R As Long, MinPrice As Double, X As String
Col = Range("XFD3").End(xlToLeft).Column
R = Range("B1000000").End(xlUp).Row
For I = 5 To R
    MinPrice = 10 ^ 10
    X = ""
    For J = 10 To Col Step 3
        If Cells(I, J).Value > 0 Then
            If Cells(I, J).Value < MinPrice Then
                MinPrice = Cells(I, J).Value
                X = Cells(I, J).Address
            End If
        End If
    Next J
    If Len(X) Then Range(X).Interior.ColorIndex = 6
Next I
End Sub
 
Upvote 0
Ba Tê đã viết:
Thử chạy Sub này cho file trên của bạn xem sao, Không cần cột V.
PHP: 
Option Explicit

Sub Tim_Min_Price()
Dim I As Long, J As Long, Col As Long, R As Long, MinPrice As Double, X As String
Col = Range("XFD3").End(xlToLeft).Column
R = Range("B1000000").End(xlUp).Row
For I = 5 To R
    MinPrice = 10 ^ 10
    X = ""
    For J = 10 To Col Step 3
        If Cells(I, J).Value > 0 Then
            If Cells(I, J).Value < MinPrice Then
                MinPrice = Cells(I, J).Value
                X = Cells(I, J).Address
            End If
        End If
    Next J
    If Len(X) Then Range(X).Interior.ColorIndex = 6
Next I
End Sub
Nhấp chuột vào đây để mở rộng...
Code đã ok anh ạ nhưng em mới nghĩ ra trường hợp nếu hai nhà cùng một mức giá (em muốn đánh dấu cả 2 thì cần làm thêm điều gì anh?)
 
Upvote 0
tueyennhi đã viết:
Code đã ok anh ạ nhưng em mới nghĩ ra trường hợp nếu hai nhà cùng một mức giá (em muốn đánh dấu cả 2 thì cần làm thêm điều gì anh?)
Nhấp chuột vào đây để mở rộng...
Đưa dữ liệu giống thật, giống những cái nếu, ... chứ tôi sao biết chỗ nào là "nếu ..."
Ý ban đầu đã không xác định, rồi nếu thì "tanh bành" cái code.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

N
  • Question Question
Tạo file lưu trữ dự liệu tự động (7 người xem)
Trả lời
6
Đọc
33
Hoàng Tuấn 868
H
N
Tạo file lưu trữ dữ liệu tự động trên excel. (6 người xem)
Trả lời
4
Đọc
45
nguyenle01
N
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ) (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
493
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian (2 người xem)
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn (3 người xem)
Trả lời
3
Đọc
127
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (1 người xem)
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ
Trả lời
4
Đọc
86
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
73
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
67
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
288
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt (2 người xem)
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL (1 người xem)
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt (2 người xem)
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
607
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ (1 người xem)
Trả lời
2
Đọc
142
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
122
HUONGHCKT
H
N
hàm đếm theo dòng
Trả lời
1
Đọc
102
dungpham01
D
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom