Hỏi đáp về VBA

handung107 · 11/6/06

Câu hỏi 1 : Lấy giá trị của ô trong VB như thế nào ?

Hỏi :

Dùng Refedit, khi người dùng chọn 1 ô nào đó rồi, không biết làm sao để lấy giá trị của ô đó, help me...

Mình đã biết hàm Cells(x,y) để lấy giá trị của một ô, nhưng khi dùng refedit thì giá trị của refedit là Data!$A$5.
Vậy nếu dùng Cells thì phải có toạ độ dòng của ô A5, nên cần phải xử lý chuỗi để lấy được chữ "A" và số "5".

Nếu dùng Rows hay Columns thì cũng phải có toạ độ dòng và cột, như vậy cũng bằng không.

Mình làm được như vậy, nhưng rắc rối quá.
Các bạn có biết hàm nào để lấy thẳng giá trị của ô đó không chỉ cho mình, nghĩa là lấy thẳng gía trị của ô mà người dùng chọn trong Refedit, mà khong phải xử lý chuỗi để lấy cột và dòng.

Trả lời :

Giả sử trong Form của bạn có control "RefEdit" đặt tên là RefEdit1 (đối tượng lấy địa chỉ ô hay vùng có kiểu là Text).
Để lấy giá trị Range(RefEdit1.Text).Value
Để lấy công thức Range(RefEdit1.Text).Formula
Để lấy cột bạn Range(RefEdit1.Text).Column
Để lấy dòng bạn Range(RefEdit1.Text).Row
Để lấy số cột Range(RefEdit1.Text).Columns.Count
Để lấy số dòng Range(RefEdit1.Text).Rows.Count
Nếu không đúng mục đích của bạn thì bạn giải thích thêm yêu cầu của bạn.
Chúc bạn thành công!

khuenguyen.tran · 12/6/06

Running Macro từ Cell của Worksheet ?

Câu hỏi 2 : Có thể running Macro từ Cell của Worksheet ?

Hỏi : Tôi muốn hỏi cách viết một hàm UDF giống như : =IF(A1>10,Macro1), để điều khiển Macro từ Cell A1 ?

Trả lời : Bạn có thể viết hàm như sau đặt trong Module :

Mã:

[B]Public Function RunMaCro(ByVal Macro_Name As String, ByVal Arg1 As Variant)[/B]
RunMaCro = Application.Run(Macro_Name, Arg1)
[B]End Function[/B]

Dĩ nhiên Macro của bạn là :

PHP:

Sub My_Macro(ByVal sMessage As String)
MsgBox sMessage, vbOKOnly, "www.giaiphapExcel.com"
End Sub

Gọi hàm từ Cell A2 :

=IF(A1>2,(RunMaCro("My_Macro","Giá trị lớn hơn 2, hãy xem lại !")),"nhỏ hơn 2")

Bạn có thể thêm nhiều đối số vào hàm trên (thí dụ ByVal Arg1 As Variant, ByVal Arg2 As Variant, ...)

Giới hạn của phương thức này là bạn không thể gọi Macro để thay đổi, update các thuộc tính về màu sắc, kích thước của Cell...

Pansy_flower · 24/6/06

Câu hỏi 3 :có phương pháp nào đếm được số ô tô màu trong excel không?

Hỏi: Em có 12 cột trong Excel, trong số đó: 4 cột để ở màu vàng, 4 cột để ở màu xanh, 4 cột để ở màu tím, 4 cột định dạng ở màu nâu.
Có bác nào biết cách dùng lệnh trong excel để đếm được số cột theo từng màu không?

Trả lời:

1.Bạn thử macro sau:

Mã:

[B]Sub CellColor()[/B]
 Dim uRange As Range, cCell As Range
 Dim Num As Long
 On Error Resume Next
 Set uRange = ActiveSheet.UsedRange
 If uRange Is Nothing Then
    MsgBox ("Khong co du lieu trong sheet " & ActiveSheet.Name)
    Exit Sub
 End If
 Num = 0
 For Each cCell In uRange
    If cCell.Interior.ColorIndex <> xlNone Then Num = Num + 1
 Next cCell
 If Num = 0 Then
    MsgBox ("Khong co o nao to mau trong sheet " & ActiveSheet.Name)
 Else
    MsgBox ("Co " & Num & " o duoc to mau trong sheet " & ActiveSheet.Name)
 End If
[B]End Sub[/B]

(answered by Adam_tran)

2.Cách làm đơn giản thôi, nhưng phải là VBA.

Viết một các function như là:
========================

PHP:

Function vbaRed() as Long
 vbaRed=vbRed
End Function

PHP:

Function vbaBlue() as Long
 vbaBlue=vbBlue
End Function

.......

Có thể viết 16 hàm màu tương ứng với 16 màu cơ bản

PHP:

Function Getcolor(Byval ColorCell as Range) As Long
 Getcolor=ColorCell.Color........
End Function

========================

Bây giờ trên các Sheet ta có thể dùng công thức như là:
=IF(Getcolor(A1)=vbaBlue(),"Mau xanh",Getcolor(A1)=vbaRed(),"Mầu đỏ",...,""))

Công thức mảng đếm số ô có màu xanh là:
{=Count(IF(Getcolor($A$1:$A$100)=vbaBlue(),1,""))}

(answered by Tuanktcdcn)

Pansy_flower · 24/6/06

Câu hỏi 4 : Dừng tính toán khi chạy macro

Hỏi: Có cách nào cho Excel dừng tính toán trong lúc chạy macro. Có thể cho nó dừng tính toàn bảng tính rồi lại cho nó tiếp tục tính không?. Nhưng trong lúc yêu cầu dừng tính có thể bảo nó chỉ tính một ô chỉ định không?

Trả lời: bạn dùng
Application.Calculation = xlCalculationManual
Sau khi thực hiện xong các Macro thì
Application.Calculation = xlCalculationAutomatic

Việc bạn muốn Excel tự tính riêng cho một Hàm tại một ô (ví dụ A1) thì dùng lệnh Range("A").Calculate

Chúc bạn thành công!

(answered by Tuanktcdcn)

Câu hỏi 5: Lấy dữ liệu từ một workbook khác

Hỏi: Các bác cho em hỏi làm sao để lấy dữ liệu từ một Workbook khác vì khi em dùng các lệnh Paste link hay offset từ một workbook đang mở thì được nhưng khi đóng workbook đó đi thì tại ô có chứa công thức báo lỗi #VALUE.

Trả lời:

Dùng macro4 để lấy giá trị từ 1 cell của closed WB

Option Explicit

Sub thu1()
MsgBox ExecuteExcel4Macro("'E:/[datasource.xls]Sheet1'!R1C1")
End Sub

Sub thu2()
ActiveCell.Value = ExecuteExcel4Macro("'E:/[datasource.xls]Sheet1'!R1C1")
End Sub

Sub thu3()
Dim Pathfile As String
Pathfile = "'E:/[datasource.xls]Sheet1'!"
ActiveCell.Value = ExecuteExcel4Macro(Pathfile & "R1C1")
End Sub

P/s: SG sửa dấu "\" thành "/" để nó không hiển thị smiling icon!

(answered by Tran Chau)

Thien · 25/6/06

Secret_grasses đã viết:
Câu hỏi 5: Lấy dữ liệu từ một workbook khác

Hỏi: Các bác cho em hỏi làm sao để lấy dữ liệu từ một Workbook khác vì khi em dùng các lệnh Paste link hay offset từ một workbook đang mở thì được nhưng khi đóng workbook đó đi thì tại ô có chứa công thức báo lỗi #VALUE.

Trả lời:

Dùng macro4 để lấy giá trị từ 1 cell của closed WB

Mã:

Option Explicit [B]Sub thu1()[/B] MsgBox ExecuteExcel4Macro("'E:[B][COLOR=red]/[/COLOR][/B][datasource.xls]Sheet1'!R1C1") [B]End Sub[/B][/COLOR]

Mã:

[B]Sub thu2[/B]() ActiveCell.Value = ExecuteExcel4Macro("'E:[COLOR=red][B]/[/B][/COLOR][datasource.xls]Sheet1'!R1C1") [B]End Sub[/B]

Mã:

[B]Sub thu3()[/B] Dim Pathfile As String Pathfile = "'E:[COLOR=red][B]/[/B][/COLOR][datasource.xls]Sheet1'!" ActiveCell.Value = ExecuteExcel4Macro(Pathfile & "R1C1") [B]End Sub[/B]

P/s: SG sửa dấu "\" thành "/" để nó không hiển thị smiling icon!

(answered by Tran Chau)

Cách này có được không:
Option Explicit

'***Copy a range from each workbook (you can select the files yourself)***

'This two examples will copy Range("A1:C1") from the first sheet of each workbook
'You can select the files yourself with GetOpenFilename.
'(hold the CTRL key when you select the files)
'Change the folder "C:\Data" 0r "\\ComputerName\YourFolder" to your folder.

'Note: Example6 is also working if your files are in a network folder.
'Note: Example6 use the function and the sub ChDirNet because ChDrive
' and ChDir is not working if your files are in a network folder.

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
========================

Mã:

[B]Public Sub ChDirNet(szPath As String)[/B]
' Rob Bovey
    Dim lReturn As Long
    lReturn = SetCurrentDirectoryA(szPath)
    If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
[B]End Sub[/B]

==================================

PHP:

Sub Example5()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim SourceRcount As Long
    Dim N As Long, rnum As Long
    Dim MyPath As String, SaveDriveDir As String
    Dim FName As Variant

    SaveDriveDir = CurDir
    MyPath = "E:\N - T\THUE 06\" ''
    ChDrive MyPath
    ChDir MyPath

    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _
                                        MultiSelect:=True)
    If IsArray(FName) Then
        Application.ScreenUpdating = False
        Set basebook = ThisWorkbook
        rnum = 1
        basebook.Worksheets.Add before:=basebook.Worksheets(1)
        'clear all cells on the first sheet'

        For N = LBound(FName) To UBound(FName)
            Set mybook = Workbooks.Open(FName(N))
            Set sourceRange = mybook.Worksheets("NKC").Range("A1:z4000")
            SourceRcount = sourceRange.Rows.Count
            Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

            basebook.Worksheets(1).Cells(rnum, "D").Value = mybook.Name
            ' This will add the workbook name in column D if you want'
            sourceRange.Copy destrange
            ' Instead of this line you can use the code below to copy only the values'

                    With sourceRange
                        Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
                                                     Resize(.Rows.Count, .Columns.Count)
                    End With
                    destrange.Value = sourceRange.Value

            mybook.Close False
            rnum = rnum + SourceRcount
        Next
    End If
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    Application.ScreenUpdating = True
End Sub

hvn8006 · 29/11/09

xin chào các anh chị. Em có thắc mắc này mà chưa tìm ra câu trả lời, mong các anh chị bớt chút thời gian chỉ giùm cho.
Viết Code trong Module và viết Code trong Sheet thì khác nhau ở chỗ nào?
ai có thể cho em một ví dụ cụ thể thật đơn giản để thực hành viết code và sử dụng nó không ạ. Em đã xem nhiều code rồi mà chưa biết sử dụng chúng như thế nào cả. Em xin chân thành cảm ơn!!!!

nhungdoahoaphudung · 4/4/11

Code trong Module và viết Code trong Sheet thì khác nhau ở chỗ nào? class dùng ntn

be_09 · 21/7/11

Viết Code trong Module thì dùng chung cho các Sheet có trong File, còn viết Code trong Sheet thì chỉ dùng riêng cho Sheet đó.

ndu96081631 · 22/7/11

be09 đã viết:
Viết Code trong Module thì dùng chung cho các Sheet có trong File, còn viết Code trong Sheet thì chỉ dùng riêng cho Sheet đó.

Phát biểu này là không đúng đâu nha!
Tôi có thể viết code ở sheet1 mà vẫn dùng được ở sheet2 đấy. Bạn tin không?

nmhung49 · 22/7/11

ndu96081631 đã viết:
Phát biểu này là không đúng đâu nha!
Tôi có thể viết code ở sheet1 mà vẫn dùng được ở sheet2 đấy. Bạn tin không?

Ở sheet1 mình có đoạn code như vầy

PHP:

Sub callcode()
MsgBox "hung"
End Sub

Sang sheet2 mình gọi đoạn code sheet1 lên bằng câu lệnh này không biết có đúng anh?

PHP:

Sub callcode1()
Sheet1.callcode
End Sub

ndu96081631 · 22/7/11

nmhung49 đã viết:
Ở sheet1 mình có đoạn code như vầy

PHP:

Sub callcode() MsgBox "hung" End Sub

Sang sheet2 mình gọi đoạn code sheet1 lên bằng câu lệnh này không biết có đúng anh?

PHP:

Sub callcode1() Sheet1.callcode End Sub

Chỉ cần bạn đừng ghi chữ "Private" vào sub, sang sheet khác, bấm Alt + F8 là hoàn toàn có thể gọi sub từ sheet kia rồi

minhtuan0588 · 23/11/13

tại sao mình chạy nó lại báo lỗi tại dòng Getcolor=ColorCell.Color........ .

minhtuan0588 · 23/11/13

Pansy_flower đã viết:
Câu hỏi 3 :có phương pháp nào đếm được số ô tô màu trong excel không?

Hỏi: Em có 12 cột trong Excel, trong số đó: 4 cột để ở màu vàng, 4 cột để ở màu xanh, 4 cột để ở màu tím, 4 cột định dạng ở màu nâu.
Có bác nào biết cách dùng lệnh trong excel để đếm được số cột theo từng màu không?

Trả lời:

1.Bạn thử macro sau:

Mã:

[B]Sub CellColor()[/B] Dim uRange As Range, cCell As Range Dim Num As Long On Error Resume Next Set uRange = ActiveSheet.UsedRange If uRange Is Nothing Then MsgBox ("Khong co du lieu trong sheet " & ActiveSheet.Name) Exit Sub End If Num = 0 For Each cCell In uRange If cCell.Interior.ColorIndex <> xlNone Then Num = Num + 1 Next cCell If Num = 0 Then MsgBox ("Khong co o nao to mau trong sheet " & ActiveSheet.Name) Else MsgBox ("Co " & Num & " o duoc to mau trong sheet " & ActiveSheet.Name) End If [B]End Sub[/B]

(answered by Adam_tran)

2.Cách làm đơn giản thôi, nhưng phải là VBA.

Viết một các function như là:
========================

PHP:

Function vbaRed() as Long vbaRed=vbRed End Function

PHP:

Function vbaBlue() as Long vbaBlue=vbBlue End Function

.......

Có thể viết 16 hàm màu tương ứng với 16 màu cơ bản

PHP:

Function Getcolor(Byval ColorCell as Range) As Long Getcolor=ColorCell.Color........ End Function

========================

Bây giờ trên các Sheet ta có thể dùng công thức như là:
=IF(Getcolor(A1)=vbaBlue(),"Mau xanh",Getcolor(A1)=vbaRed(),"Mầu đỏ",...,""))

Công thức mảng đếm số ô có màu xanh là:
{=Count(IF(Getcolor($A$1:$A$100)=vbaBlue(),1,""))}

(answered by Tuanktcdcn)

tại sao mình lại chạy không được nhỉ, nó báo lỗi ở dòng Getcolor=ColorCell.Color........, đổi lại Getcolor=ColorCell.Color cũng không được

nmhung49 · 23/11/13

minhtuan0588 đã viết:
tại sao mình lại chạy không được nhỉ, nó báo lỗi ở dòng Getcolor=ColorCell.Color........, đổi lại Getcolor=ColorCell.Color cũng không được

Bạn chạy ở đâu cái này là function dùng giống các hàm như hàm sum của excel chẳng hạn được nói bạn chạy trong module

komono · 18/12/13

mấy anh xem giùm em
Private Sub Cmdsearch_Click()
Dim Search As String, Where
Search = TextBox1.Text
Where = InStr(TextBox1.Text, Search)
If Where = 0 Then
MsgBox "XIN VUI LONG NHAP TEN CAN TIM", , " MESSAGE"
Exit Sub
End If

If Where > 0 Then
Cells.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Else
MsgBox " XIN LOI VI KHONG TIM THAY, CAM ON BAN", , "MESSAGE"
End If
End Sub

sai chổ nào sửa giùm em
nó chạy nhưng khi tìm ko ra nó báo lỗi

Let'GâuGâu · 18/12/13

komono đã viết:
mấy anh xem giùm em
sai chổ nào sửa giùm em
nó chạy nhưng khi tìm ko ra nó báo lỗi

thử vậy xem
bạn search thêm topic find method của site này

Mã:

Private Sub Cmdsearch_Click()

Dim Search As String, Where
Dim timkiem As Range
Search = TextBox1.Text
Where = InStr(TextBox1.Text, Search)
If Where = 0 Then
MsgBox "XIN VUI LONG NHAP TEN CAN TIM", , " MESSAGE"
Else
Set timkiem = Cells.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
    If Not timkiem Is Nothing Then
        timkiem.Select
    Else
        MsgBox " XIN LOI VI KHONG TIM THAY, CAM ON BAN", , "MESSAGE"
    End If
End If
End Sub

komono · 20/12/13

Let'GâuGâu đã viết:

thử vậy xem
bạn search thêm topic find method của site này

Mã:

Private Sub Cmdsearch_Click()

Dim Search As String, Where
Dim timkiem As Range
Search = TextBox1.Text
Where = InStr(TextBox1.Text, Search)
If Where = 0 Then
MsgBox "XIN VUI LONG NHAP TEN CAN TIM", , " MESSAGE"
Else
Set timkiem = Cells.Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
    If Not timkiem Is Nothing Then
        timkiem.Select
    Else
        MsgBox " XIN LOI VI KHONG TIM THAY, CAM ON BAN", , "MESSAGE"
    End If
End If
End Sub

nếu muốn tìm trong cột D không thì sửa code lại sao anh

SA_DQ · 20/12/13

Nếu muốn tìm trong cột D không thì sửa code lại sao anh

PHP:

Set TimKiem = Columnls("D:D").Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns)

Bạn thử câu lệnh này xem sao?

komono · 20/12/13

hyen17 đã viết:
PHP:

set timkiem = columnls("d:d").find(what:=search, after:=activecell, lookin:=xlformulas, _ lookat:=xlpart, searchorder:=xlbycolumns)

bạn thử câu lệnh này xem sao?

ko chạy dc anh ơi anh xem lại giùm

komono · 20/12/13

Private Sub Cmdsearch_Click()

Dim Search As String, Where
Dim timkiem As Range
Search = TextBox1.Text
Where = InStr(TextBox1.Text, Search)
If Where = 0 Then
MsgBox "XIN VUI LONG NHAP TEN CAN TIM", , " MESSAGE"
Else
Set timkiem = Columns("D

").Find(What:=Search, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not timkiem Is Nothing Then
timkiem.Select
Else
MsgBox " XIN LOI VI KHONG TIM THAY, CAM ON BAN", , "MESSAGE"
End If
End If
End Sub

để chuột ở cột D thì tìm được còn cột khác nó báo lỗi

Hỏi đáp về VBA

Thành viên gắn bó

Thành viên mới

...nợ người, nợ đời...

...nợ người, nợ đời...

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

Thành viên chính thức

Thành viên chính thức

Biên Hòa, Đồng Nai

Huyền thoại GPE

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

Huyền thoại GPE

Thành viên mới

Thành viên mới

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

Thành viên hoạt động

Thành viên mới

Thành viên hoạt động

/(hông là gì!

Thành viên hoạt động

Thành viên hoạt động