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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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
Help me....! mình có 1 file xecell gồm 2 sheet (data và packing) bên sheet data mình có cột A là tên chi tiết mình muốn dùng 1 đoạn code bằng VBA tự đông copy dữ liệu ở cột A sheet "data" sang cột B sheet "packing" - ở cột A sheet data có một vài ô không có dư liệu thì không copy. nếu dùng autofillter rồi copy/past vẫn đc nhừng mình muốn ứng dung VBA để học hỏi, có ai giúp mình đoạn code.
 

File đính kèm

Upvote 0
LamTran0202 đã viết:
Help me....! mình có 1 file xecell gồm 2 sheet (data và packing) bên sheet data mình có cột A là tên chi tiết mình muốn dùng 1 đoạn code bằng VBA tự đông copy dữ liệu ở cột A sheet "data" sang cột B sheet "packing" - ở cột A sheet data có một vài ô không có dư liệu thì không copy. nếu dùng autofillter rồi copy/past vẫn đc nhừng mình muốn ứng dung VBA để học hỏi, có ai giúp mình đoạn code.
Nhấp chuột vào đây để mở rộng...
Hiếp tôi. Hiếp tôi ...
Đây là Topic "Giải đáp những thắc mắc vè Code VBA" mờ
 
Upvote 0
Mã: 
Sub tao_ngau_nhien()
   Dim arr_1(9), arr_2(9) As Long
   Dim i As Long
  
  
    
   Dim hm As WorksheetFunction
   Set hm = Application.WorksheetFunction
   For i = LBound(arr_2) To UBound(arr_2)
      arr_1(i) = Rnd
      'arr_2(i) = hm.Rank(arr_1(i), ...............
      Debug.Print arr_1(i), arr_2(i)
      
   Next i

End Sub
Em mới học em đang bế tắc ở bước viết code cho hàm RANK. Mong thầy, cô các bạn chỉ bảo
 
Upvote 0
Em chưa nghĩ ra cách chỉnh code để đếm số lượng (số lần xuất hiện) của cột TKTG theo điều kiện như trong file. Mong các Sư phụ chỉ giúp!
Mã: 
Sub test1()
    Worksheets("Sheet2").Select
    Dim dic As Object
    Dim iRow As Long, i As Long
    Dim Arr() As Variant, VungDuLieu As Variant

    Dim k As Variant
    
    With Sheets("Sheet2")
        Set dic = CreateObject("Scripting.Dictionary")
        Set Dic2 = CreateObject("Scripting.Dictionary")
        VungDuLieu = Range("A1", Range("A1").End(xlToRight).End(xlDown).Address).Value '65536 '1048576
        ReDim Arr(1 To UBound(VungDuLieu, 1), 1 To 29)
        
        VungDuLieu2 = Range("O2:O40").Value
        
        For iRow = 1 To UBound(VungDuLieu, 1)
            If Not IsEmpty(VungDuLieu(iRow, 5)) And Not dic.Exists(VungDuLieu(iRow, 5)) Then
                i = i + 1
                dic.Add VungDuLieu(iRow, 5), i
                Arr(i, 1) = VungDuLieu(iRow, 5)
                
                'MsgBox "Tai: " & iRow & "___" & VungDuLieu(iRow, 7)
            Else
                
            End If
            
        Next iRow
        
        
        
    End With
    
    'MsgBox dic.count
    
    Sheets("Sheet2").Select
    With Sheets("Sheet2")
        .Range("O2").Resize(i, 3).Value = Arr
    End With
    Set dic = Nothing
End Sub
 
Upvote 0
Lequocvan đã viết:
Em chưa nghĩ ra cách chỉnh code để đếm số lượng (số lần xuất hiện) của cột TKTG theo điều kiện như trong file. Mong các Sư phụ chỉ giúp!
Mã: 
Sub test1()
    Worksheets("Sheet2").Select
    Dim dic As Object
    Dim iRow As Long, i As Long
    Dim Arr() As Variant, VungDuLieu As Variant

    Dim k As Variant
  
    With Sheets("Sheet2")
        Set dic = CreateObject("Scripting.Dictionary")
        Set Dic2 = CreateObject("Scripting.Dictionary")
        VungDuLieu = Range("A1", Range("A1").End(xlToRight).End(xlDown).Address).Value '65536 '1048576
        ReDim Arr(1 To UBound(VungDuLieu, 1), 1 To 29)
      
        VungDuLieu2 = Range("O2:O40").Value
      
        For iRow = 1 To UBound(VungDuLieu, 1)
            If Not IsEmpty(VungDuLieu(iRow, 5)) And Not dic.Exists(VungDuLieu(iRow, 5)) Then
                i = i + 1
                dic.Add VungDuLieu(iRow, 5), i
                Arr(i, 1) = VungDuLieu(iRow, 5)
              
                'MsgBox "Tai: " & iRow & "___" & VungDuLieu(iRow, 7)
            Else
              
            End If
          
        Next iRow
      
      
      
    End With
  
    'MsgBox dic.count
  
    Sheets("Sheet2").Select
    With Sheets("Sheet2")
        .Range("O2").Resize(i, 3).Value = Arr
    End With
    Set dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn thử như vầy xem
PHP: 
Sub test1()
    Dim Dic As Object
    Dim sArr, dArr, I As Long, K As Long
With Sheets("Sheet2")
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 10).Value
    ReDim dArr(1 To UBound(sArr), 1 To 3)
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(sArr(I, 5)) Then
            K = K + 1
            Dic.Add sArr(I, 5), K
            dArr(K, 1) = sArr(I, 5)
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(K, 2) = 1 Else dArr(K, 3) = 1
            End If
        Else
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(Dic.Item(sArr(I, 5)), 2) = dArr(Dic.Item(sArr(I, 5)), 2) + 1 Else _
                        dArr(Dic.Item(sArr(I, 5)), 3) = dArr(Dic.Item(sArr(I, 5)), 3) + 1
            End If
        End If
    Next I
End With
With Sheets("Sheet2")
    If K Then .Range("O3").Resize(K, 3).Value = dArr
End With
Set Dic = Nothing
End Sub
 
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Bạn thử như vầy xem
PHP: 
Sub test1()
    Dim Dic As Object
    Dim sArr, dArr, I As Long, K As Long
With Sheets("Sheet2")
    Set Dic = CreateObject("Scripting.Dictionary")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 10).Value
    ReDim dArr(1 To UBound(sArr), 1 To 3)
    For I = 1 To UBound(sArr)
        If Not Dic.Exists(sArr(I, 5)) Then
            K = K + 1
            Dic.Add sArr(I, 5), K
            dArr(K, 1) = sArr(I, 5)
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(K, 2) = 1 Else dArr(K, 3) = 1
            End If
        Else
            If sArr(I, 2) = "HoiSo" Then
                If sArr(I, 10) = "USD" Then dArr(Dic.Item(sArr(I, 5)), 2) = dArr(Dic.Item(sArr(I, 5)), 2) + 1 Else _
                        dArr(Dic.Item(sArr(I, 5)), 3) = dArr(Dic.Item(sArr(I, 5)), 3) + 1
            End If
        End If
    Next I
End With
With Sheets("Sheet2")
    If K Then .Range("O3").Resize(K, 3).Value = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
File bài này đâu cho anh xem với nhỉ?
 
Upvote 0
Upvote 0
Upvote 0
HieuCD đã viết:
Chắc phải ra chợ Kim Biên mua mấy ổ khóa, tối về khóa "máy tính" lại cho yên tâm :p
"If sArr(I, 2) = "HoiSo" Then" dùng 2 lần thấy sao sao ấy, dùng 1 lần được không :)
Nhấp chuột vào đây để mở rộng...
Lúc đầu em cũng đưa ra ngoài Dic nhưng nhà họ yêu cầu đếm duy nhất và tổng hợp số lượng với cái "HoiSo" nên lại đưa vào trong Anh ạ. Hay Anh viết lại cho em học với
 
Upvote 0
♫ђöล♥ßล†♥†µ♫ đã viết:
Lúc đầu em cũng đưa ra ngoài Dic nhưng nhà họ yêu cầu đếm duy nhất và tổng hợp số lượng với cái "HoiSo" nên lại đưa vào trong Anh ạ. Hay Anh viết lại cho em học với
Nhấp chuột vào đây để mở rộng...
Đưa ra ngoài cho gọn
Mã: 
Sub test1()
    Dim Dic As Object, ikey
    Dim sArr, dArr, i As Long, k As Long, ik As Long
    
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
    sArr = .Range("A2:J2", .Range("A" & Rows.Count).End(xlUp)).Value
End With
    ReDim dArr(1 To UBound(sArr), 1 To 3)
    For i = 1 To UBound(sArr)
        ikey = sArr(i, 5)
        If Not Dic.Exists(ikey) Then
            k = k + 1
            Dic.Add ikey, k
            dArr(k, 1) = ikey
        End If
        If sArr(i, 2) = "HoiSo" Then
          ik = Dic.Item(ikey)
          If ik > 0 Then
            If sArr(i, 10) = "USD" Then
              dArr(ik, 2) = dArr(ik, 2) + 1
            Else
              dArr(ik, 3) = dArr(ik, 3) + 1
            End If
          End If
        End If
    Next i
    Set Dic = Nothing
With Sheets("Sheet2")
    If k Then .Range("O3:Q3").Resize(k).Value = dArr
End With
End Sub
 
Upvote 0
Tuyệt cú mèo, yêu thế cơ chứ! Cảm ơn Chị nhé!
 
Upvote 0
Dạ chào các anh chị
Em mới tìm hiểu lập trình VBA, khi chạy đoạn code này nó báo lỗi. Em không biết lỗi thế nào, anh chị giúp em với
1540107708615.png
 
Upvote 0
Nhờ mọi người giúp đỡ, bổ sung thêm tính năng cho các lệnh có sắn trong excell
Em có gửi file và đoạn record macro ghi lại tính năng lọc sẵn có của excell.
Mặc định của excell cho phép lọc với 2 điều kiện (ở đây là không bắt đầu với "Quyet dinh" và không bắt đầu với "Hop dong")
Giờ em muốn bổ sung thành 3 điều kiện (thêm không bắt đầu với "To trinh") thì phải làm sao ạ?
Mã: 
Sub Loc3Lan()
'' Loc3Lan Macro

    ActiveSheet.Range("$A$6:$H$13").AutoFilter Field:=8, Criteria1:= _
        "<>Quyet dinh*", Operator:=xlAnd, Criteria2:="<>Hop dong*"
End Sub

Thank and best regards.
 

File đính kèm

Upvote 0
Nhờ các cao thủ giúp mình vụ này với.

Mình copy được đoạn VBA dưới đây, để copy tự động sheet đầu tiên của các file được chọn. (Mình sử dụng để tổng hợp dữ liệu từ các file dữ liệu của nhiều đơn vị khi làm báo cáo)

Tuy nhiên, sheet đầu tiên của các file được chọn có công thức link số liệu sang các sheet khác hoặc các file khác (và ko hiển thị đúng số liệu), mình muốn thêm chức năng Break link hoặc chỉ copy Value của các sheet đó. Nhờ mọi người sửa giúp. Cám ơn mọi người rất nhiều


Sub GopFileExcel()
Dim FilesToOpen
Dim x As Integer
Dim wb As Workbook

On Error GoTo ErrHandler
Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", MultiSelect:=True, Title:="Files to Merge")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1
While x <= UBound(FilesToOpen)
Set wb = Workbooks.Open(Filename:=FilesToOpen(x))

If x = 1 Then
wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets(1).Range("A1")
Else
lr = ThisWorkbook.Sheets(1).UsedRange.Rows.Count
wb.Sheets(1).UsedRange.Offset(1).Copy ThisWorkbook.Sheets(1).Range("A" & lr + 1)
End If

wb.Close False
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Set wb = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
 
Upvote 0
Các anh chị cho em hỏi chút.
Em có đoạn code dưới để xoá các sheet ẩn. Nhưng dòng code While không chạy được.Em nhờ các anh chị sửa giúp em được không ạ

Sub deletehidden()
Dim a As Integer
a = 1
While a <= worksheets=\"\" count=\"\" span=\"\">
If Not Worksheets(a).Visible Then
Worksheets(a).Delete
Else
a = a + 1
End If
Wend
End Sub
 
Upvote 0
forpromise2013 đã viết:
Các anh chị cho em hỏi chút.
Em có đoạn code dưới để xoá các sheet ẩn. Nhưng dòng code While không chạy được.Em nhờ các anh chị sửa giúp em được không ạ

Sub deletehidden()
Dim a As Integer
a = 1
While a <= worksheets=\"\" count=\"\" span=\"\">
If Not Worksheets(a).Visible Then
Worksheets(a).Delete
Else
a = a + 1
End If
Wend
End Sub
Nhấp chuột vào đây để mở rộng...
Cho những cái gì là công thức, là code vào chỗ này này.

1540655470539.png
-------
Code trên kia copy ở đâu mà ra nông nỗi thế?

PHP: 
While a<= Thisworkbook.worksheets.count
 
Upvote 0
befaint đã viết:
...
Code trên kia copy ở đâu mà ra nông nỗi thế?

PHP: 
While a<= Thisworkbook.worksheets.count
Nhấp chuột vào đây để mở rộng...
Chắc cóp trên mạng nào đó.
Code While-Wend là cũ lắm rồi. Khoảng đời VBA mới vừa được cho thẳng vào Excel 97. (Trước đó Excel 5 thì phải lắp thêm VBA mới có mà xài.)

Chú: trước đây tôi cũng hay dùng While-Wend, và đó là thói quen cũ từ thời thượng.
 
Upvote 0
Code đó xưa rồi. Mà cũng không đúng nguyên tắc.
Nguyên tắc delete phần tử của collection là phải dò theo chỉ số ngược (từ lớn đến nhỏ)

For i = WorkSheets.Count To 1 Step -1
' xét WorkSheets(i) và delete nếu cần
Next i
 
Upvote 0
e cần chép data từ file source sang file collect. cột F của file source có giá trị bao nhiêu thì data sẽ đưa vào sheet tương ứng trong file collect
- có nút nhấn để chọn file source
- dữ liệu trong file collect được chép thêm vào chứ không bị đè lên

cảm ơn anh chị trước
 

File đính kèm

Upvote 0
Mình đang gặp vấn đề về việc checkbox trên excel (thực thi bằng code vba).
Hiện tại, khi mình click vào checkbox nó sẽ chạy một condition (mình record macros và chép vào vba ok),
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then Range("D5").Select
ActiveWindow.SmallScroll Down:=33
Range("D5:AF49").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=IF(WEEKDAY(D$5)=1,TRUE,FALSE)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With

If CheckBox1.Value = False Is Nothing Then
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Bây giờ nếu mình bỏ tick checkbox, mình muốn nó clear các condition trong phần vùng mình chỉ định đó thì viết code như thế nào.
Và không bị lặp lại các condition khi tick và bỏ tick nhiều lần.
DO mình tự tìm hiểu và mò nên có gì mấy bạn hướng dẫn giúp
THanks.
 
Upvote 0
Nhờ mọi người giúp đỡ bài này
Ô C9 là tổng của các ô từ D9 đến I9. Nếu 1 ô hàng 7 có giá trị là X và ô dưới nó hàng 8 có giá trị là 1 thì các ô hàng 9 từ cột đó về trước sẽ là 0, ví dụ ô G7=X và G8 =1 thì các ô từ D9 đến G9 sẽ bằng 0. Mình có đoạn code thế này mà chưa được, tại ô C9 sẽ gõ =SumByRow(D7:I7,9).
Function SumByRow(xlrange As range, r As Integer)
If xlrange Is Nothing Then
Set xlrange = Application.ThisCell
End If
With ActiveSheet
Dim ws As Worksheet
Dim lastColumn As Integer
Set ws = ActiveSheet

Dim i As Integer
Dim iCol As Integer
Dim a As Integer
iCol = ActiveCell.Column + 1
i = xlrange.Find("X").Column
'find last column of row
lastColumn = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column
For a = iCol To i
Cells(r, a).Value = 0
Next
SumByRow = WorksheetFunction.Sum(range(Cells(r, iCol), Cells(r, lastColumn))
End With
End Function
1541649109174.png
 

File đính kèm

Upvote 0
vanphu1607 đã viết:
Nhờ mọi người giúp đỡ bài này
Ô C9 là tổng của các ô từ D9 đến I9. Nếu 1 ô hàng 7 có giá trị là X và ô dưới nó hàng 8 có giá trị là 1 thì các ô hàng 9 từ cột đó về trước sẽ là 0, ví dụ ô G7=X và G8 =1 thì các ô từ D9 đến G9 sẽ bằng 0. Mình có đoạn code thế này mà chưa được, tại ô C9 sẽ gõ =SumByRow(D7:I7,9).
Function SumByRow(xlrange As range, r As Integer)
If xlrange Is Nothing Then
Set xlrange = Application.ThisCell
End If
With ActiveSheet
Dim ws As Worksheet
Dim lastColumn As Integer
Set ws = ActiveSheet

Dim i As Integer
Dim iCol As Integer
Dim a As Integer
iCol = ActiveCell.Column + 1
i = xlrange.Find("X").Column
'find last column of row
lastColumn = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column
For a = iCol To i
Cells(r, a).Value = 0
Next
SumByRow = WorksheetFunction.Sum(range(Cells(r, iCol), Cells(r, lastColumn))
End With
End Function
View attachment 207255
Nhấp chuột vào đây để mở rộng...
C9=SUM(OFFSET(D9,,IFERROR(LOOKUP(2,1/(D7:I7="X")/(D8:I8=1),ROW(1:6)),0)):I9)
 
Upvote 0
HieuCD đã viết:
C9=SUM(OFFSET(D9,,IFERROR(LOOKUP(2,1/(D7:I7="X")/(D8:I8=1),ROW(1:6)),0)):I9)
Nhấp chuột vào đây để mở rộng...
Bạn cho hỏi sao hàm For dưới đây không hoạt động, không set giá trị các cell bằng 0 được?
Function SumByRow(xlrange As Range, r As Integer)
If xlrange Is Nothing Then
Set xlrange = Application.ThisCell
End If
With ActiveSheet
Dim ws As Worksheet
Dim lastColumn As Integer
Set ws = ActiveSheet

Dim i As Integer
Dim iCol As Integer
Dim a As Integer
iCol = ActiveCell.Column + 1
i = xlrange.Find("M").Column
'find last column of row
lastColumn = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column

For a = iCol To i
Cells(r, a).Value = 0
Next a

SumByRow = WorksheetFunction.Sum(Range(Cells(r, iCol), Cells(r, lastColumn)))
End With
End Function
 
Upvote 0
vanphu1607 đã viết:
Xin lỗi, chính xác là Cells(r, a).Value = 0 không chạy
Nhấp chuột vào đây để mở rộng...
"không chạy" tức là sao?
hỏi mà đưa chi tiết nhỏ giọt vậy ai trả lời nổi?

Đoán già đoán non (*):
Đây là 1 hàm. Người hỏi không hề cho biết hàm được dùng/gọi ở đâu và tham số được nạp vào là gì.
Dựa vào cái lệnh Application.ThisCell thì đoán mò là hàm UDF, được áp dụng vào một cell hay range (hàm mảng) nào đó trên sheet.
Mà luật của hàm UDF thì đương nhiên là không cho sửa bảng tính rồi.

(*) bản thân tôi không thích đoán mò. Tôi chỉ cốt ý giải thích cho bạn ở bài #1591 thôi
 
Upvote 0
VetMini đã viết:
"không chạy" tức là sao?
hỏi mà đưa chi tiết nhỏ giọt vậy ai trả lời nổi?

Đoán già đoán non (*):
Đây là 1 hàm. Người hỏi không hề cho biết hàm được dùng/gọi ở đâu và tham số được nạp vào là gì.
Dựa vào cái lệnh Application.ThisCell thì đoán mò là hàm UDF, được áp dụng vào một cell hay range (hàm mảng) nào đó trên sheet.
Mà luật của hàm UDF thì đương nhiên là không cho sửa bảng tính rồi.

(*) bản thân tôi không thích đoán mò. Tôi chỉ cốt ý giải thích cho bạn ở bài #1591 thôi
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn.
Mình có 1 bài như file đính kèm, thử đoạn code trên nhưng chưa được, bạn có thể giúp đỡ đc ko?
 

File đính kèm

Upvote 0
Có hai kiểu nói chuyện mà tôi từ chối, thứ nhất là dùng tiếng Tây và thứ hai là dùng ngôn ngữ tét - viết tắt tùm lum.
 
Upvote 0
Xin chào các bạn,
Khi Oanh Thơ khai báo 1 hằng,ví dụ :
Public Const Var2 = 20
Có code nào sau khi chạy thì dòng trên sẽ chuyển thành dòng sau không?
Public Const Var2 = 25
 
Upvote 0
Lý do tại sao bạn muốn nó là hằng?
Từ tên đến bản chất, cái bạn muốn là biến mà!
 
Upvote 0
VetMini đã viết:
Lý do tại sao bạn muốn nó là hằng?
Từ tên đến bản chất, cái bạn muốn là biến mà!
Nhấp chuột vào đây để mở rộng...
Chào Bác VetMini,
Dạ, tại vì cháu muốn sử dụng rộng ở các module khác nên cháu khai báo chung như vậy.
Nhưng trong trường hợp nào đó cháu muốn nó thay đổi nên cháu hỏi để hiểu thêm ạ.
Cháu đặt tên như vậy là vì cháu đã xem các bài viết ở bài viết này:
https://www.giaiphapexcel.com/diendan/threads/bài-4-biến-trong-vba.130732/#post-891460

nên cháu copy qua bên này luôn ạ, cháu nghĩ nếu hỏi bên chủ đề đó sẽ không tiện lắm ạ.
Cháu hỏi chỉ để tham khảo chưa có mục đích gì ạ.

Cháu Cảm ơn Bác VetMini đã quan tâm.
Nếu có cách bào Bác chỉ cho cháu ạ.
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Khi Oanh Thơ khai báo 1 hằng,ví dụ :
Public Const Var2 = 20
Có code nào sau khi chạy thì dòng trên sẽ chuyển thành dòng sau không?
Public Const Var2 = 25
Nhấp chuột vào đây để mở rộng...
constant = bất biến, không thay đổi. Nếu được như trên thì hóa ra Var2 là hằng "nhái" à?

Hay là tôi không cập nhật thông tin?
 
Upvote 0
batman1 đã viết:
constant = bất biến, không thay đổi. Nếu được như trên thì hóa ra Var2 là hằng "nhái" à?

Hay là tôi không cập nhật thông tin?
Nhấp chuột vào đây để mở rộng...
Hình như cô ta muốn khởi trị. Biến VBA trước khi khởi trị thì nó có mặc định (0 cho số).

Nếu muốn vậy thì làm như sau:

Public Var1 As Integer
Public Var2 As Integer
...

Public Sub KhoiTri()
Var1 = 20
Var2 = 21
...
End Sub

Trong sự kiện Workbook_Open, đặt thêm câu này ngay đầu hàm:
KhoiTri

Sau đó, muốn thay đổi nó ở đâu tuỳ thích.

Chú: bản chất của Const là không thay đổi. Người đọc code LUÔN LUÔN tin rằng nó không bao giờ thay đổi.
Nếu, với một thủ thuật vặn vẹo nào đó mà bạn thay đổi được nó thì có phải bạn tự làm mất niềm tin của người khác chăng?
 
Upvote 0
batman1 đã viết:
constant = bất biến, không thay đổi. Nếu được như trên thì hóa ra Var2 là hằng "nhái" à?

Hay là tôi không cập nhật thông tin?
Nhấp chuột vào đây để mở rộng...

Bác!
Dạ, vâng cháu hiểu rồi khi đã khai báo và gán cho hằng một giá trị nhất định thì không thể thay đổi được ạ.
Cảm ơn Bác nhiều ạ.
 
Upvote 0
VetMini đã viết:
Hình như cô ta muốn khởi trị. Biến VBA trước khi khởi trị thì nó có mặc định (0 cho số).

Nếu muốn vậy thì làm như sau:

Public Var1 As Integer
Public Var2 As Integer
...

Public Sub KhoiTri()
Var1 = 20
Var2 = 21
...
End Sub

Trong sự kiện Workbook_Open, đặt thêm câu này ngay đầu hàm:
KhoiTri

Sau đó, muốn thay đổi nó ở đâu tuỳ thích.

Chú: bản chất của Const là không thay đổi. Người đọc code LUÔN LUÔN tin rằng nó không bao giờ thay đổi.
Nếu, với một thủ thuật vặn vẹo nào đó mà bạn thay đổi được nó thì có phải bạn tự làm mất niềm tin của người khác chăng?
Nhấp chuột vào đây để mở rộng...
cháu tưởng là khi biến vào 1 chương trình con thì nó có thể nhận giá trị của chương trình con đó khi thoát ra ngoài chương trình thì nó lại trở về giá trị biến toàn cục nhỉ bac.
 
Upvote 0
VetMini đã viết:
Hình như cô ta muốn khởi trị. Biến VBA trước khi khởi trị thì nó có mặc định (0 cho số).

Nếu muốn vậy thì làm như sau:

Public Var1 As Integer
Public Var2 As Integer
...

Public Sub KhoiTri()
Var1 = 20
Var2 = 21
...
End Sub

Trong sự kiện Workbook_Open, đặt thêm câu này ngay đầu hàm:
KhoiTri

Sau đó, muốn thay đổi nó ở đâu tuỳ thích.

Chú: bản chất của Const là không thay đổi. Người đọc code LUÔN LUÔN tin rằng nó không bao giờ thay đổi.
Nếu, với một thủ thuật vặn vẹo nào đó mà bạn thay đổi được nó thì có phải bạn tự làm mất niềm tin của người khác chăng?
Nhấp chuột vào đây để mở rộng...

Chú: bản chất của Const là không thay đổi. Người đọc code LUÔN LUÔN tin rằng nó không bao giờ thay đổi.
Nhấp chuột vào đây để mở rộng...
Đây là vấn đề cháu muốn hỏi ạ.
ý cháu khi đã gán hằng một giá trị riêng biệt ở một module khác thì có các nào thay đổi giá trị đó được không giống như mình phải mở cửa sổ alt+f11 lên và tìm đến giá trị đó xóa đi và sửa lại ấy ạ. Giống như chạy code để sửa giá trị trong name ấy ạ.
Híc, Có lẽ là do sự kém hiểu biết nên cháu hỏi buồn cười. Giờ cháu đã hiểu.
Cháu cảm ơn hai bác Siwtom và Vetmini nhiều ạ.
 
Upvote 0
snow25 đã viết:
cháu tưởng là khi biến vào 1 chương trình con thì nó có thể nhận giá trị của chương trình con đó khi thoát ra ngoài chương trình thì nó lại trở về giá trị biến toàn cục nhỉ bac.
Nhấp chuột vào đây để mở rộng...
Cái bạn nói trên là THAM SỐ, và là THAM TRỊ.
Khi vào chương trình con (Sub/Function), VBA copy tất cả các tham trị. Bên trong chương trình con, các tham trị được coi như là biến nội.

Biến toàn cục là ...toàn cục. Bất cứ hàm nào có thể chạm vào nó đều có thể thay dổi trị của nó. Public có nghĩa là cho phép mọi hàm đều chạm vào được. Chính vì tính chất này mà dân lập trình chân chính luôn sử dụng biến toàn cục một cách hết sức dè dặt và cẩn trọng.
 
Upvote 0
VetMini đã viết:
Cái bạn nói trên là THAM SỐ, và là THAM TRỊ.
Khi vào chương trình con (Sub/Function), VBA copy tất cả các tham trị. Bên trong chương trình con, các tham trị được coi như là biến nội.

Biến toàn cục là ...toàn cục. Bất cứ hàm nào có thể chạm vào nó đều có thể thay dổi trị của nó. Public có nghĩa là cho phép mọi hàm đều chạm vào được. Chính vì tính chất này mà dân lập trình chân chính luôn sử dụng biến toàn cục một cách hết sức dè dặt và cẩn trọng.
Nhấp chuột vào đây để mở rộng...
vâng ạ.
 
Upvote 0
snow25 đã viết:
cháu tưởng là khi biến vào 1 chương trình con thì nó có thể nhận giá trị của chương trình con đó khi thoát ra ngoài chương trình thì nó lại trở về giá trị biến toàn cục nhỉ bac.
Nhấp chuột vào đây để mở rộng...
Nếu là câu hỏi (về biến số) thì hãy nói trọn câu, rõ nghĩa. Có ai hiểu ở trên nói gì cụ thể không? Hiểu chứ không phải đoán mò.

Còn nếu
Mã: 
Public Var1 As Long
...

Sub hichic (...)
...
End Sub

Mà bạn muốn truyền Var1 vào hichic thì còn tùy.
Mã: 
Public Var1 As Long

Sub hichic(ByVal a As Long)
    a = 1000
End Sub

Sub test()
    Var1 = 2
    hichic Var1
    MsgBox Var1
End Sub

Sau khi chạy test thì Var1 = 2, tức như trước khi chạy test

Nếu
Mã: 
Public Var1 As Long

Sub hichic(ByRef a As Long) ' hoặc a As Long
    a = 1000
End Sub

Sub test()
    Var1 = 2
    hichic Var1
    MsgBox Var1
End Sub
Thì sau khi chạy test Var1 = 1000
 
Upvote 0
Em có chút rắc rối với file này ạ
Chạy code nó cứ báo lỗi type Missmatch ạ

Mục đích là lọc dữ liệu theo yêu cầu ạ
Mã: 
Sub test()

Dim sArr(), dArr() As Long, i As Long, j As Long
Dim dieukien As Variant, day As Variant, cot As Long

With Sheets(1)

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

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

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

Next i
Sheets("filter").Delete
Sheets.Add Application.Sheets(1)
Sheets(1).Name = "filter"
Sheets(1).Range("A1").Resize(, UBound(dArr, 2)) = dArr

End With
End Sub
 

File đính kèm

Upvote 0
Bạn sửa dòng lệnh đầu tiên thành vầy, chắc được:
Mã: 
Dim sArr(), dArr() As Variant, I As Long, J As Long
 
Upvote 0
Bác có thể chỉ em cách sửa không ạ. Em ngồi mò nãy giờ mà không ra ạ
 
Upvote 0
vn.danhmay đã viết:
Em có chút rắc rối với file này ạ
Chạy code nó cứ báo lỗi type Missmatch ạ

Mục đích là lọc dữ liệu theo yêu cầu ạ
Nhấp chuột vào đây để mở rộng...

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

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

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

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

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

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

Next i
Sheets("filter").Delete
...
Nhấp chuột vào đây để mở rộng...
câu lệnh end ở đấy nó có ảnh hưởng gì đến code ở dưới không bác mà nó đặt ở đây thì nó kết thúc cái gì ạ.
 
Upvote 0
Đây là thành quả sau cùng của em ạ :D
Mã: 
Sub tachdulieu()

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

With Sheets("Sheet1")

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

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

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

End If
Next i

End With

On Error GoTo tiep

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

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

Application.DisplayAlerts = True
End Sub
 
Upvote 0
snow25 đã viết:
câu lệnh end ở đấy nó có ảnh hưởng gì đến code ở dưới không bác mà nó đặt ở đây thì nó kết thúc cái gì ạ.
Nhấp chuột vào đây để mở rộng...
tam888 đã viết:
không, nó kết thúc sub/fuction đó luôn, nên các lệnh dưới không có tác dụng gì
Nhấp chuột vào đây để mở rộng...
Xin lỗi. Ở trên tôi nói "chẳng end cái gì cả" là ý muốn nói đến mấy cái blocks. Đọc lại mới nhận ra mình nói hấp tấp quá cho nên nghĩa hoàn toàn trái ngược.
Lệnh "End" nó ngưng tất cả, ngưng chạy code, giải thoát biến trong bộ nhớ, và đóng các files mà nó mở bằng lệnh "Open" (những file mở bằng cách khác thì chưa chắc)
 
Upvote 0
VetMini đã viết:
Lệnh "End" nó ngưng tất cả, ngưng chạy code, giải thoát biến trong bộ nhớ, và đóng các files mà nó mở bằng lệnh "Open" (những file mở bằng cách khác thì chưa chắc)
Nhấp chuột vào đây để mở rộng...
Em thấy không đóng những files đó anh.

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

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

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

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

File đính kèm

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

PHP: 
x1
 
Upvote 0
Chào bạn befaint, mình đã sửa lại code và k báo lỗi nữa, nhưng nó chỉ con trỏ vào ô mình muốn hiện ảnh nhưng lại k load được ảnh lên, bạn giúp mình với, code mình sửa
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Picname As String
Dim Width As Integer
Dim Height As Integer
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect([G9], Target) Is Nothing Then
Set Rng = Sheet1.Range(Sheet1.[B8], Sheet1.[B1000].End(xlUp))
Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Find("Target").Offset(0, 14)
Sheet2.Shapes([I5].Address).Delete
[I5].Select
With ActiveSheet.Picture.Insert(Picname)
.Name = [I5].Address
Width = 100
Height = 150
End With
ActiveSheet.Shapes("$I$5").IncrementTop 30#
ActiveSheet.Shapes("$I$5").IncrementLeft 0
End If
Application.ScreenUpdating = True
End Sub
 
Upvote 0
thanhliem_mta đã viết:
Chào bạn befaint, mình đã sửa lại code và k báo lỗi nữa, nhưng nó chỉ con trỏ vào ô mình muốn hiện ảnh nhưng lại k load được ảnh lên, bạn giúp mình với, code mình sửa
Nhấp chuột vào đây để mở rộng...
Tại sao bạn không sửa bài khi đã được nhắc?
Bôi đen toàn bộ code rồi nhấn nút Code để cho nó vào thẻ như trong bài của tôi dưới đây.

Nếu muốn lần sau được giúp thì hãy sửa lại.

Sai:
1. Find(Target.Value) hoặc Find(Target) chứ không phải Find("Target")
2. ActiveSheet.Pictures chứ không phải ActiveSheet.Picture
3. Kod hiện hành nhập ảnh vào ActiveSheet nhưng Sheet2 không được kích hoạt nên ActiveSheet vẫn là Sheet1, tức ảnh được nhập vào Sheet1 không đúng dụng ý.
4.
Mã: 
With ActiveSheet.Picture.Insert(Picname)
.Name = [I5].Address
Width = 100
Height = 150
End With
Width, Height không dùng ở các phần sau thì thiết lập làm gì cho tốn điện nước? Còn nếu tôi đoán được dụng ý thì phải là .Width, .Height, nhưng lúc đó khai báo Width, Height là thừa.

5. Với code ở dưới thì trong cột P phải có tên ảnh và định dạng. Tức vd. hichic.jpg chứ không được chỉ hichic. Nếu các ảnh đều có định dạng JPG thì chỉ nên nhập tên ảnh (hichic) trong cột P và sửa
Mã: 
Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value
thành
Mã: 
Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value & ".jpg"

6. Code
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Picname As String
Dim fso As Object
    Application.ScreenUpdating = False
    If Target.Address = "$G$9" Then
        Set Rng = Sheet1.Range(Sheet1.[B8], Sheet1.[B1000].End(xlUp))
        Set Rng = Rng.Find(Target.Value)  ' hoac Rng.Find(Target)
        If Not Rng Is Nothing Then
            Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.fileexists(Picname) Then
                With Sheet2
                    On Error Resume Next
                    .Shapes("$I$5").Delete
                    On Error GoTo 0
                    With .Pictures.Insert(Picname)
                        .Name = "$I$5"
                        .ShapeRange.LockAspectRatio = msoFalse
                        .Placement = xlMoveAndSize
                        .Left = Sheet2.Range("I5").Left
                        .Top = Sheet2.Range("I5").Top
                        .width = 100
                        .height = 150
                    End With
                End With
            End If
            Set fso = Nothing
        End If
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
batman1 đã viết:
Tại sao bạn không sửa bài khi đã được nhắc?
Bôi đen toàn bộ code rồi nhấn nút Code để cho nó vào thẻ như trong bài của tôi dưới đây.

Nếu muốn lần sau được giúp thì hãy sửa lại.

Sai:
1. Find(Target.Value) hoặc Find(Target) chứ không phải Find("Target")
2. ActiveSheet.Pictures chứ không phải ActiveSheet.Picture
3. Kod hiện hành nhập ảnh vào ActiveSheet nhưng Sheet2 không được kích hoạt nên ActiveSheet vẫn là Sheet1, tức ảnh được nhập vào Sheet1 không đúng dụng ý.
4.
Mã: 
With ActiveSheet.Picture.Insert(Picname)
.Name = [I5].Address
Width = 100
Height = 150
End With
Width, Height không dùng ở các phần sau thì thiết lập làm gì cho tốn điện nước? Còn nếu tôi đoán được dụng ý thì phải là .Width, .Height, nhưng lúc đó khai báo Width, Height là thừa.

5. Với code ở dưới thì trong cột P phải có tên ảnh và định dạng. Tức vd. hichic.jpg chứ không được chỉ hichic. Nếu các ảnh đều có định dạng JPG thì chỉ nên nhập tên ảnh (hichic) trong cột P và sửa
Mã: 
Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value
thành
Mã: 
Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value & ".jpg"

6. Code
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Picname As String
Dim fso As Object
    Application.ScreenUpdating = False
    If Target.Address = "$G$9" Then
        Set Rng = Sheet1.Range(Sheet1.[B8], Sheet1.[B1000].End(xlUp))
        Set Rng = Rng.Find(Target.Value)  ' hoac Rng.Find(Target)
        If Not Rng Is Nothing Then
            Picname = ThisWorkbook.Path & "\Hinh\" & Rng.Offset(0, 14).Value
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.fileexists(Picname) Then
                With Sheet2
                    On Error Resume Next
                    .Shapes("$I$5").Delete
                    On Error GoTo 0
                    With .Pictures.Insert(Picname)
                        .Name = "$I$5"
                        .ShapeRange.LockAspectRatio = msoFalse
                        .Placement = xlMoveAndSize
                        .Left = Sheet2.Range("I5").Left
                        .Top = Sheet2.Range("I5").Top
                        .width = 100
                        .height = 150
                    End With
                End With
            End If
            Set fso = Nothing
        End If
    End If
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bài đã được tự động gộp:

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

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

Cảm ơn bạn Batman1, mình đã thành công rồi. Cảm ơn bạn nhiều lắm
Nhấp chuột vào đây để mở rộng...


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

PHP: 
x1
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn rất nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
thanhliem_mta đã viết:
Bạn Batman 1 ơi, cho mình hỏi chút: Nếu bây giờ mình có 2 tên nhân viên giống nhau nhưng là 2 người khác nhau, nếu tìm theo tên thì làm sao để hiện ảnh lên được? Giúp mình với
Nhấp chuột vào đây để mở rộng...
Thế nếu bạn có 2 nữ nhân viên đều là Hương mà sếp nói: Bảo cô Hương lên thảm quỳ của tôi. Thì bạn chọn bừa 1 cô hay bạn nói: Hoặc sếp cho em mã nhân viên hoặc cho em bí danh a. Một cô là Hương búp bê còn cô kia là Hương mắt nâu ạ.
Bạn còn không biết chọn cô Hương nào thì còn nói gì tới code.
 
Upvote 0
batman1 đã viết:
Thế nếu bạn có 2 nữ nhân viên đều là Hương mà sếp nói: Bảo cô Hương lên thảm quỳ của tôi. Thì bạn chọn bừa 1 cô hay bạn nói: Hoặc sếp cho em mã nhân viên hoặc cho em bí danh a. Một cô là Hương búp bê còn cô kia là Hương mắt nâu ạ.
Bạn còn không biết chọn cô Hương nào thì còn nói gì tới code.
Nhấp chuột vào đây để mở rộng...
Hỏi lại sếp thì không dám mà chọn bừa thì cũng khó. Một bên búp bê và một bên mắt nâu thì nửa cân tám lạng thật bác ạ.
Bác ra lại đi, cô Hương bên đèo và cô Hương lưng đồi thì tôi còn nhắm mắt chọn.
 
Lần chỉnh sửa cuối:
Upvote 0
Bỏ cả 4 người lên"Chiếc nón kì diệu" mà sổ số thôi; Trúng 1 trong 2 cô thì được chọn; Trúng bạn hay sếp bạn thì . . . . (tự biết fải làm gì đi nha)
 
Upvote 0
SA_DQ đã viết:
Bỏ cả 4 người lên"Chiếc nón kì diệu" mà sổ số thôi; Trúng 1 trong 2 cô thì được chọn; Trúng bạn hay sếp bạn thì . . . . (tự biết fải làm gì đi nha)
Nhấp chuột vào đây để mở rộng...
Bác bi quan quá. Trúng khổ chủ thì còn có GPE!
 
Upvote 0
Nhờ các anh em trên GPE giải đáp giúp mình vấn đề sau.
Mình cũng đã cố tìm bằng các từ khóa trên gg và ở GPE nhưng không tìm ra đc chủ đề mình đang thắc mắc là:
Khi mình lấy giá trị từ sheet này sang sheet khác dùng
sheet1.range.value = sheet2.range
Nhanh hơn hay dùng mảng array sẽ nhanh hơn
Array = sheet1.range.value
Sheet2.range.resize = array

Và tương tự, gắn giá trị vào mảng rồi resize xuống range sẽ nhanh hơn hay cho vòng lặp chạy thẳng vào range sẽ nhanh hơn.
Ví dụ code mảng 1 chiều

For i = LBound(array) to UBound(array)
Array2(i) = array(i)
Next i
Sheet.range("A1").resize(UBound,) = transpose(Array2)

Và
For i = LBound(array) to UBound(array)
Sheet.range("A" & i).value = array(i)
Next i

Thì cái nào sẽ nhanh hơn.

Mong mọi người giải đáp giúp mình với ạ.
Mình cảm ơn trước.

Nếu trong khi diễn giải có gì sai sót mong mọi người thông cảm bỏ qua vì mình cũng mới học về vba nên có nhiều cái chưa chuẩn xác lắm.
Cảm ơn mọi người.
 
Upvote 0
Code này mình muốn thay đổi và tìm kiếm có dấu và font Times New Roman được vậy mấy bác

Sub DoReplace()

Const Find1 = "CAR-060"
Const Replace1 = "CAR-034"

Const Find2 = " second find string "
Const Replace2 = " second replacement "

Dim FilePick As FileDialog
Dim FileSelected As FileDialogSelectedItems
Dim WordFile As Variant ' FileName placeholder in selected files loop
Dim FileJob As String ' Filename for processing

Dim WorkDoc As Object
Dim WholeDoc As Range
Dim FooterDoc As Range

' On Error GoTo CreateReports_Error

Set FilePick = Application.FileDialog(msoFileDialogFilePicker)

With FilePick
.Title = "Choose Report Template"
.Filters.Clear
.Filters.Add "Word Documents & Templates", "*.do*"
.Filters.Add "Word 2003 Document", "*.doc"
.Filters.Add "Word 2003 Template", "*.dot"
.Filters.Add "Word 2007 Document", "*.docx"
.Filters.Add "Word 2007 Template", "*.dotx"
.Show
End With

Set FileSelected = FilePick.SelectedItems

If FileSelected.Count <> 0 Then

For Each WordFile In FileSelected

FileJob = WordFile

Set WorkDoc = Application.Documents.Open(FileJob, , , , , , , , , , , False)

Set WholeDoc = WorkDoc.Content
Set FooterDoc = WorkDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range

With FooterDoc
.Find.Execute Find1, True, True, , , , True, , , Replace1, wdReplaceAll
.Find.Execute Find2, True, True, , , , True, , , Replace2, wdReplaceAll
End With

With WholeDoc.Find
.Execute Find1, True, True, , , , True, , , Replace1, wdReplaceAll
End With

WorkDoc.Save
WorkDoc.Close

Next

End If

MsgBox "Completed"

DoReplace_Exit:

Set WholeDoc = Nothing
Set FilePick = Nothing

Set WorkDoc = Nothing
Set FooterDoc = Nothing

Exit Sub

DoReplace_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DoReplace of VBA Document ReplaceMulti"
Resume DoReplace_Exit

End Sub

Private Sub Document_New()

End Sub
 
Upvote 0
FungoChan79 đã viết:
Nhờ các anh em trên GPE giải đáp giúp mình vấn đề sau.
Mình cũng đã cố tìm bằng các từ khóa trên gg và ở GPE nhưng không tìm ra đc chủ đề mình đang thắc mắc là:
Khi mình lấy giá trị từ sheet này sang sheet khác dùng
sheet1.range.value = sheet2.range
Nhanh hơn hay dùng mảng array sẽ nhanh hơn
Array = sheet1.range.value
Sheet2.range.resize = array

Và tương tự, gắn giá trị vào mảng rồi resize xuống range sẽ nhanh hơn hay cho vòng lặp chạy thẳng vào range sẽ nhanh hơn.
Ví dụ code mảng 1 chiều

For i = LBound(array) to UBound(array)
Array2(i) = array(i)
Next i
Sheet.range("A1").resize(UBound,) = transpose(Array2)

Và
For i = LBound(array) to UBound(array)
Sheet.range("A" & i).value = array(i)
Next i

Thì cái nào sẽ nhanh hơn.

Mong mọi người giải đáp giúp mình với ạ.
Mình cảm ơn trước.

Nếu trong khi diễn giải có gì sai sót mong mọi người thông cảm bỏ qua vì mình cũng mới học về vba nên có nhiều cái chưa chuẩn xác lắm.
Cảm ơn mọi người.
Nhấp chuột vào đây để mở rộng...
theo mình nghĩ thì khi cho vào mảng nó sẽ nhanh hơn.
 
Upvote 0
Mọi người cho e hỏi. Có cách nào mình Dim và set giá trị cho biến. để dùng đc ở các sub và module khác mà k cần set lại ko ạ. Cám ơn
 
Upvote 0
Upvote 0
Được, nhưng với mục đích của bạn thì e rằng không nên.
Biến toàn cục dùng phải hết sức cẩn thận, vì vậy thường dùng cái tên khá dài để khó lẫn lộn. Người hay viết tắt thì có lẽ mục đích chỉ là do lười khai báo nhiều lần. Cứ biến a, b, c, i, j, k thì chắc chắn sẽ có ngày bể ổ.
 
Upvote 0
VetMini đã viết:
Được, nhưng với mục đích của bạn thì e rằng không nên.
Biến toàn cục dùng phải hết sức cẩn thận, vì vậy thường dùng cái tên khá dài để khó lẫn lộn. Người hay viết tắt thì có lẽ mục đích chỉ là do lười khai báo nhiều lần. Cứ biến a, b, c, i, j, k thì chắc chắn sẽ có ngày bể ổ.
Nhấp chuột vào đây để mở rộng...
Được : thì làm ntn ạ
 
Upvote 0
noinhodayvoi20_10 đã viết:
Dạng khai báo biến hả A.
Rồi e muốn set gtri cho nó luôn và cái sub khác xài gtri biến đó.
Hướng dẫn cụ thể e vs ạ
Nhấp chuột vào đây để mở rộng...
bạn cứ khai báo bình thường rồi truyền giá trị cho nó ở đâu cũng được nhé trong sub hoặc ngoài cũng được nó vẫn ghi nhớ hết
 
Upvote 0
VetMini đã viết:
Hình như cô ta muốn khởi trị. Biến VBA trước khi khởi trị thì nó có mặc định (0 cho số).

Nếu muốn vậy thì làm như sau:

Public Var1 As Integer
Public Var2 As Integer
...

Public Sub KhoiTri()
Var1 = 20
Var2 = 21
...
End Sub

Trong sự kiện Workbook_Open, đặt thêm câu này ngay đầu hàm:
KhoiTri

Sau đó, muốn thay đổi nó ở đâu tuỳ thích.

Chú: bản chất của Const là không thay đổi. Người đọc code LUÔN LUÔN tin rằng nó không bao giờ thay đổi.
Nếu, với một thủ thuật vặn vẹo nào đó mà bạn thay đổi được nó thì có phải bạn tự làm mất niềm tin của người khác chăng?
Nhấp chuột vào đây để mở rộng...
Cái đặt ngay đầu hàm là sao ta :d
Chứ k phải sử dụng call cái sub khoitri ay trk hã
 
Upvote 0
Upvote 0
Chào mọi người.
Em chỉ mới tìm hiểu VBA nên nhờ mọi người giúp đỡ.
Bài toán như sau: Em nhập 1 số tại A1 của sheet1
+Nếu A1>10 =>Thông báo a lớn hơn 10
+Nếu A1=10 =>Thông báo a bằng 10
+Nếu A1<10 =>Thông báo a nhỏ hơn 10
+Nếu A1 là chữ =>Thông báo a là dạng Text
Em xin cám ơn
 

File đính kèm

Upvote 0
Gà cận thị đã viết:
Chào mọi người.
Em chỉ mới tìm hiểu VBA nên nhờ mọi người giúp đỡ.
Bài toán như sau: Em nhập 1 số tại A1 của sheet1
+Nếu A1>10 =>Thông báo a lớn hơn 10
+Nếu A1=10 =>Thông báo a bằng 10
+Nếu A1<10 =>Thông báo a nhỏ hơn 10
+Nếu A1 là chữ =>Thông báo a là dạng Text
Em xin cám ơn
Nhấp chuột vào đây để mở rộng...
Bạn thử:
PHP: 
Sub LenhIf()
    a = Sheet1.Range("A1")
    If IsNumeric(a) = False Then MsgBox "a la dang Text"
    If IsNumeric(a) = True Then
        If a > 10 Then
            MsgBox "a lon hon 10"
        ElseIf a = 10 Then
            MsgBox "a bang 10"
        Else
            MsgBox "a nho hon 10"
        End If
    End If
End Sub
 
Upvote 0
phulien1902 đã viết:
Bạn thử:
PHP: 
Sub LenhIf()
    a = Sheet1.Range("A1")
    If IsNumeric(a) = False Then MsgBox "a la dang Text"
    If IsNumeric(a) = True Then
        If a > 10 Then
            MsgBox "a lon hon 10"
        ElseIf a = 10 Then
            MsgBox "a bang 10"
        Else
            MsgBox "a nho hon 10"
        End If
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn anh nhiều !
 
Upvote 0
Em có việc khó không biết làm sao nhờ cả nhà giúp.
Em có 1 Form nhập dữ liệu vào 1 sheet A. giờ em gặp khó là làm sao khi nhập vào form mà trùng tên (VD: text tên trùng với cột B trong Sheet A là tên) thì khi click vào lưu thì báo đã có tên trùng với tên đó và không cho lưu dữ liệu trùng đó nữa. Tks cả nhà.
 
Upvote 0
Các Anh/chị, Chú Bác cho e hỏi bên diễn đàn mình có chỗ nào bán cuốn sách lập trình về VBA không ạ. Xuất bản mới mới :)
Cám ơn
 
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

D
in ra bị thiếu chữ (1 người xem)
Trả lời
3
Đọc
37
ptm0412
ptm0412
Momominh
Hỏi công thức tìm tuần thiếu hàng (1 người xem)
Trả lời
1
Đọc
40
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 (1 người xem)
Trả lời
2
Đọc
31
ptm0412
ptm0412
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
2
Đọc
74
victoriabmt
V
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định (1 người xem)
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
394
Đọc
46K
ThanhsonLC
T
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
Trả lời
24
Đọc
25K
dungpham01
D
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (2 người xem)
Trả lời
6
Đọc
276
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
7
Đọc
429
ongke0711
ongke0711
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • 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 (7 người xem)
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
42K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
596
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
117
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
102
HUONGHCKT
H
N
hàm đếm theo dòng
Trả lời
1
Đọc
89
dungpham01
D
H
LỖI KHOẢNG TRỐNG EXCEL DƯỚI THANH CÔNG CỤ
Trả lời
1
Đọc
63
ptm0412
ptm0412
A
  • Question Question
Share file copy dữ liệu từ tờ khai hải quan.
    • Thích
Trả lời
10
Đọc
991
anhdepjai
A
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
6
Đọc
324
le_vis
L
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