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

maytinhvp01 · 31/7/13

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]

VetMini · 20/8/19

quocturtle đã viết:
Chào mọi người
Mình có một function đơn giản như sau:
...

Thành viên lâu năm, hỏi cũng không ít bài, sao không biết tôn trọng luật "Đăng Bài Nhiều Nơi" vậy?

Lỗi lạ với Evaluate(Replace(..))

Chào mọi người Mình có một function đơn giản như sau: Function func01(str As String, X As Variant) func01 = Evaluate(Replace(str, "x", X)) End Function Cơ bản thì hàm này dùng như sau: ví dụ mình có hàm f(x) = ln(x) + x^2. Mình muốn tính f(x) với x = 2 chẳng hạng thì mình có 2 cách Cách 1...

www.giaiphapexcel.com

snow25 · 20/8/19

quocturtle đã viết:
Chào mọi người
Mình có một function đơn giản như sau:

Mã:

Function func01(str As String, X As Variant) func01 = Evaluate(Replace(str, "x", X)) End Function

Cơ bản thì hàm này dùng như sau: ví dụ mình có hàm f(x) = ln(x) + x^2. Mình muốn tính f(x) với x = 2 chẳng hạng thì mình có 2 cách
Cách 1: =Ln(A1) + A1^2. Với A1=2 <-- Cái này ko có gì đáng nói
Cách 2: dùng hàm mình viết func01. Mình nhập là =func01("ln(x)+x^2",A1) trong đó A1=2. Hàm func01 sẽ thay thế các giá trị x bằng giá trị ở A1, tức 2. Kết quả ra tương đương với cách 1.

Tuy nhiên bây giờ có 1 vấn đề mà mấy ngày nay mình hỏi khắp nơi ko ra là như vậy:

nếu hàm func01("x",A1) tức là A1 thế nào thì func01 trả ra thế đấy.
Vấn đề bắt đầu từ đây,
1. Hàm func01 xài được với mọi trường hợp, mọi hàm trừ duy nhất khi là func01("x",A1) và giá trị A1=1. Chỉ duy nhất trường hợp này trả ra giá trị lỗi. Mọi người xem Cell C12 trong file Excel đính kèm giúp mình

2. Nếu các bạn mởi 1 sheet độc lập, viết lại hàm func01 y chang thì.
2.1 Dừng lại ở đây thì hàm func01 trả ra giá trị đúng với func01("x",A1)=1 với A1=1
2.2 Nếu thêm UserForm các thứ thì lỗi lại bị. ???

Ruốt cuộc mình chẳng biết vấn đề là từ đâu ra nữa
Anh em bạn bè gần xa, có ai cao thủ vụ này giúp mình với.

Cảm ơn mọi người

Bạn thử.

Mã:

Function func01(str As String, X As Variant)
       Dim s
       s = Replace(str, "x", X)
       If s = 1 Then
          func01 = 1
       Else
          func01 = Evaluate(s)
       End If
End Function

quocturtle · 21/8/19

snow25 đã viết:
Bạn thử.

Mã:

Function func01(str As String, X As Variant) Dim s s = Replace(str, "x", X) If s = 1 Then func01 = 1 Else func01 = Evaluate(s) End If End Function

Ah cảm ơn bạn nhiều. Cách này mình cũng đang dùng tạm để giải quyết vấn đề, nhưng mà kiểu nói sao nhỉ. Nó giống như mình thấy nó giống chấp vá hơn á. Mình sợ vd hiện tại chỉ tìm ra được vấn đề với hàm "x" và giá trị 1, lỡ nó có vd với 1 hàm nào đó khác thì sao. Đang cố gắng hiểu coi sao tự nhiên nó có cái error trên trời này rơi xuống

Cảm ơn bạn nhiều

Bài đã được tự động gộp: 21/8/19

VetMini đã viết:
Thành viên lâu năm, hỏi cũng không ít bài, sao không biết tôn trọng luật "Đăng Bài Nhiều Nơi" vậy?

Lỗi lạ với Evaluate(Replace(..))

Chào mọi người Mình có một function đơn giản như sau: Function func01(str As String, X As Variant) func01 = Evaluate(Replace(str, "x", X)) End Function Cơ bản thì hàm này dùng như sau: ví dụ mình có hàm f(x) = ln(x) + x^2. Mình muốn tính f(x) với x = 2 chẳng hạng thì mình có 2 cách Cách 1...

www.giaiphapexcel.com

Xin lỗi bạn nhiều. Bạn đầu tạo cái thread ngoài kia xong thấy có 1 thread chuyên về VBA nên mình sợ loãng forum nên post vào đây. Định delete cái kia mà quay đi quay lại quên mất. Cảm ơn bạn nhắc nhở, mình để ý hơn

phananhvusv · 27/8/19

Mấy bác cho em hỏi, trong file ví dụ về Dictionary phía dưới. Trong cái code VBA có 2 dòng
Set dic2 = CreateObject("Scripting.Dictionary")
dic2.CompareMode = vbTextCompare
Em không hiểu tại sao phải đặt 2 dòng này ở chỗ này thì mới được ạ. Em thử đem lên chỗ khai báo biến thì báo lỗi.
Em chạy thử bằng F8 và xem Watch thì thấy mỗi lần chạy qua 2 dòng này thì dic2.count = 0. Nhưng đến khi có key đã tồn tại thì lại vẫn chạy ra số đã lưu trước đó.
Giải thích giúp em với ạ.

Mã:

Option Explicit

Sub MakeTheList()
    
    Dim dic As Object
    Dim dic2 As Object
    Dim Contents As Variant
    Dim ParentKeys As Variant
    Dim ChildKeys As Variant
    Dim r As Long, r2 As Long
    Dim LastR As Long
    Dim WriteStr As String
    
    ' Create "parent" Dictionary.  Each key in the parent Dictionary will be a disntict
    ' Code value, and each item will be a "child" dictionary.  For these "children"
    ' Dictionaries, each key will be a distinct Product value, and each item will be the
    ' sum of the Quantity column for that Code - Product combination
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    ' Dump contents of worksheet into array
    
    With ThisWorkbook.Worksheets("Data")
        LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        Contents = .Range("a2:c" & LastR).Value
    End With
        
    ' Loop through the array
    
    For r = 1 To UBound(Contents, 1)
        
        ' If the current code matches a key in the parent Dictionary, then set dic2 equal
        ' to the "child" Dictionary for that key
        
        If dic.Exists(Contents(r, 1)) Then
            Set dic2 = dic.Item(Contents(r, 1))
            
            ' If the current Product matches a key in the child Dictionary, then set the
            ' item for that key to the value of the item now plus the value of the current
            ' Quantity
            
            If dic2.Exists(Contents(r, 2)) Then
                dic2.Item(Contents(r, 2)) = dic2.Item(Contents(r, 2)) + Contents(r, 3)
            
            ' If the current Product does not match a key in the child Dictionary, then set
            ' add the key, with item being the amount of the current Quantity
            
            Else
                dic2.Add Contents(r, 2), Contents(r, 3)
            End If
        
        ' If the current code does not match a key in the parent Dictionary, then instantiate
        ' dic2 as a new Dictionary, and add an item (Quantity) using the current Product as
        ' the Key.  Then, add that child Dictionary as an item in the parent Dictionary, using
        ' the current Code as the key
        
        Else
            Set dic2 = CreateObject("Scripting.Dictionary")
            dic2.CompareMode = vbTextCompare
            dic2.Add Contents(r, 2), Contents(r, 3)
            dic.Add Contents(r, 1), dic2
        End If
    Next
    
    ' Add a new worksheet for the results
    
    Worksheets.Add
    [a1:b1].Value = Array("Code", "Product - Qty")
    
    ' Dump the keys of the parent Dictionary in an array
    
    ParentKeys = dic.Keys
    
    ' Write the parent Dictionary's keys (i.e., the distinct Code values) to the worksheet
    
    [a2].Resize(UBound(ParentKeys) + 1, 1).Value = Application.Transpose(ParentKeys)
    
    ' Loop through the parent keys and retrieve each child Dictionary in turn
    
    For r = 0 To UBound(ParentKeys)
        Set dic2 = dic.Item(ParentKeys(r))
        
        ' Dump keys of child Dictionary into array and initialize WriteStr variable (which will
        ' hold concatenated products and summed Quantities
        
        ChildKeys = dic2.Keys
        WriteStr = ""
        
        ' Loop through child keys and retrieve summed Quantity value for that key.  Build both
        ' of these into the WriteStr variable.  Recall that Excel uses linefeed (ANSI 10) for
        ' in-cell line breaks
        
        For r2 = 0 To dic2.Count - 1
            WriteStr = WriteStr & Chr(10) & ChildKeys(r2) & " - " & dic2.Item(ChildKeys(r2))
        Next
        
        ' Trim leading linefeed
        
        WriteStr = Mid(WriteStr, 2)
        
        ' Write concatenated list to worksheet
        
        Cells(r + 2, 2) = WriteStr
    Next
    
    ' Sort and format return values
    
    [a1].Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
    With [b:b]
        .ColumnWidth = 40
        .WrapText = True
    End With
    Columns.AutoFit
    Rows.AutoFit
    
    ' Destroy object variables
    
    Set dic2 = Nothing
    Set dic = Nothing
    
    MsgBox "Done"
    
End Sub

AnhThu-1976 · 28/8/19

Em có code

Mã:

Sub Macro1()
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("D1").Select
End Sub[\code\
Bây giờ em muốn Paste value C1
Em dùng Value=Value thì báo lỗi
Hỏi muốn dùng cách trên thì làm như thế nào, em cảm ơn!

snow25 · 28/8/19

AnhThu-1976 đã viết:

Em có code

Mã:

Sub Macro1()
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("D1").Select
End Sub[\code\
Bây giờ em muốn Paste value C1
Em dùng Value=Value thì báo lỗi
Hỏi muốn dùng cách trên thì làm như thế nào, em cảm ơn!

Bạn thử cái này.
Formula

phulien1902 · 28/8/19

AnhThu-1976 đã viết:

Em có code

Mã:

Sub Macro1()
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]+RC[-1]"
        Range("D1").Select
End Sub[\code\
Bây giờ em muốn Paste value C1
Em dùng Value=Value thì báo lỗi
Hỏi muốn dùng cách trên thì làm như thế nào, em cảm ơn!

Bạn thêm dòng:

PHP:

Range("C1").Value = Range("C1").Value

kokano90 · 28/8/19

Nhờ các Thầy cô chỉ giúp em với.
Mục đích của em là:
Nếu chon vào ô bất kì có dòng nào thì ở dữ liệu tại cột A của dòng đó hiện màu đỏ lên. chọn dòng khác thì sẽ về mặc định màu đen ạ
Em cám ơn nhiều ạ

Mã:

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
Dim r&
r = Target.Row
Range("A" & r).Font.Color = -16776961
End Sub

phulien1902 · 28/8/19

kokano90 đã viết:
Nhờ các Thầy cô chỉ giúp em với.
Mục đích của em là:
Nếu chon vào ô bất kì có dòng nào thì ở dữ liệu tại cột A của dòng đó hiện màu đỏ lên. chọn dòng khác thì sẽ về mặc định màu đen ạ
Em cám ơn nhiều ạ

Mã:

Private Sub Worksheet_Selectionchange(ByVal Target As Range) Dim r& r = Target.Row Range("A" & r).Font.Color = -16776961 End Sub

Chép Code vào ThisworkBook nhé, bạn thử:

PHP:

Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Static Rng As Range
    On Error Resume Next
    Target.Font.ColorIndex = 3
    Rng.Font.ColorIndex = 1
    Set Rng = Target
End Sub

kokano90 · 28/8/19

phulien1902 đã viết:
Chép Code vào ThisworkBook nhé, bạn thử:

PHP:

Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Static Rng As Range On Error Resume Next Target.Font.ColorIndex = 3 Rng.Font.ColorIndex = 1 Set Rng = Target End Sub

Cám ơn anh vì đã trả lời ạ.
Phiền anh chút nữa ạ. Ý em là khi chọn bất kì chẳng hạn chọn A1 hoặc B1, hoặc C1.... miễn là ở dòng 1 thì dữ liệu tại A1 sẽ đỏ. khi chọn cells bất kì ở dòng 2 thì dữ liệu ở A2 sẽ đỏ. còn các dòng khác màu đen bình thường ạ

phulien1902 · 28/8/19

kokano90 đã viết:
Cám ơn anh vì đã trả lời ạ.
Phiền anh chút nữa ạ. Ý em là khi chọn bất kì chẳng hạn chọn A1 hoặc B1, hoặc C1.... miễn là ở dòng 1 thì dữ liệu tại A1 sẽ đỏ. khi chọn cells bất kì ở dòng 2 thì dữ liệu ở A2 sẽ đỏ. còn các dòng khác màu đen bình thường ạ

Vậy bạn thay bằng:

PHP:

Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Static Rng As Range
    On Error Resume Next
    Target.EntireRow.Font.ColorIndex = 3
    Rng.EntireRow.Font.ColorIndex = 1
    Set Rng = Target
End Sub

kokano90 · 28/8/19

phulien1902 đã viết:
Vậy bạn thay bằng:

PHP:

Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Static Rng As Range On Error Resume Next Target.EntireRow.Font.ColorIndex = 3 Rng.EntireRow.Font.ColorIndex = 1 Set Rng = Target End Sub

Cám ơn anh nhiều ạ. Cho em hỏi thêm chút nữa. nếu em chỉ muốn dữ liệu ở cột A nó được nổi màu lên thì phải sửa thế nào ạ

Thanh1102 · 29/8/19

Các anh/chị vui lòng xem giúp đoạn code báo lỗi: "Subcript out of range" tại dArr(K, J) = sArr(I, J) trong đoạn code sau:
Public Sub Noisheet()
Dim sArr(), dArr(1 To 65000, 1 To 100), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End Sub

Note: Mục đích gộp các sheet vào 1 sheet.

Thanh1102 · 29/8/19

emcute đã viết:
dArr(1 To 65000, 1 To 100)

Mảng đích có 100 cột. Mảng nguồn chắc hơn 100 cột...

Không phải bạn ơi. Để lên 1000 cũng vẫn báo lỗi vậy.

snow25 · 29/8/19

Thanh1102 đã viết:
Các anh/chị vui lòng xem giúp đoạn code báo lỗi: "Subcript out of range" tại dArr(K, J) = sArr(I, J) trong đoạn code sau:
Public Sub Noisheet()
Dim sArr(), dArr(1 To 65000, 1 To 100), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End Sub

Note: Mục đích gộp các sheet vào 1 sheet.

Bạn thử chưa test nhé.Nếu vẫn có lỗi thì đưa file lên nhé.

Mã:

Public Sub Noisheet()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long, max As Long, a As Long
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
   tong = tong + Ws.Range("A" & Rows.Count).End(xlUp).Row
   a = Ws.[AV11].End(2).Column
   If a > max Then max = a
End If
End If
Next
If tong > Rows.Count Then MsgBox "nhieu dong qua": Exit Sub
ReDim dArr(1 To tong, 1 To max)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1

For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End sub

batman1 · 29/8/19

Thanh1102 đã viết:
Không phải bạn ơi. Để lên 1000 cũng vẫn báo lỗi vậy.

1000 thì đã là cái gì đâu.

Không có tập tin mà đoán mò thì mệt lắm.

Mã:

sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)

Giả sử code chạy trên Excel >= 2007, và sheet hiện hành chỉ có dữ liệu từ A11 tới AV11.

Lúc này Ws.[AV11].End(2).Column trả về 16384. Tức UBound(sArr, 2) = 16384

Vậy

Mã:

For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J

sẽ có lỗi khi J > UBound(dArr, 2) (khi J > 100, khi J > 1000)

Ngoài ra nếu tổng các số dòng có dữ liệu trong tất cả các sheet > 65000 thì cũng có lỗi khi K > 65000 vì dArr chỉ có 65000 dòng. Nhưng không có tập tin thì chỉ là đoán mò, chỉ là "NẾU".

Cũng chả thấy mô tả dữ liệu. Tôi hiểu là các sheet có thể có cột cuối cùng có dữ liệu khác nhau ở dòng 11, vd. trong sheet đầu chỉ tới cột Z, trong sheet khác tới AV, trong sheet khác nữa tới AZ, rồi sau đó tới L ... Nhưng trong mỗi sheet ấy thì từ A11 tới <xyz>11 có ô trống không? Tức vd. A11<> rỗng, AV11 <> rỗng, nhưng liệu có vd. AA11 = rỗng.

Không có tập tin, không có mô tả dữ liệu thì chỉ mất thời gian vô ích của nhau.

Thanh1102 · 29/8/19

snow25 đã viết:

Bạn thử chưa test nhé.Nếu vẫn có lỗi thì đưa file lên nhé.

Mã:

Public Sub Noisheet()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long, max As Long, a As Long
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
   tong = tong + Ws.Range("A" & Rows.Count).End(xlUp).Row
   a = Ws.[AV11].End(2).Column
   If a > max Then max = a
End If
End If
Next
If tong > Rows.Count Then MsgBox "nhieu dong qua": Exit Sub
ReDim dArr(1 To tong, 1 To max)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Sum" Then
If Ws.Name <> "Total" Then
sArr = Ws.Range(Ws.[A11], Ws.[A65000].End(xlUp)).Resize(, Ws.[AV11].End(2).Column)
If Ws.[A11].End(2).Column > Col Then Col = Ws.[AV11].End(2).Column
For I = 1 To UBound(sArr, 1)
K = K + 1

For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(I, J)
Next J
Next I
End If
End If
Next
With Sheets("Total")
.[A7:AV65000].ClearContents
If K Then .[A7].Resize(K, Col).Value = dArr
End With
End sub

Cảm ơn bạn. Code đã chạy và không còn báo lỗi. Sau khi chạy xong data > 12000 dòng nên khá chậm

batman1 · 29/8/19

Thanh1102 đã viết:
Cảm ơn bạn. Code đã chạy và không còn báo lỗi. Sau khi chạy xong data > 12000 dòng nên khá chậm

Nếu có trường hợp tôi nói thì còn ngạc nhiên gì nữa? Vì lúc đó sArr và dArr luôn có 16384 cột và duyệt chúng, rồi đập mảng 12000 dòng và 16384 cột xuống sheet lâu là đương nhiên.

Nếu trong tất cả các sheet cột cuối cùng có dữ liệu ở dòng 11 KHÔNG BAO GIỜ vượt quá AV (AZ, BB ...) thì lấy luôn từ A tới AV chứ bầy trò Ws.[AV11].End(2).Column để làm gì?

Còn nếu cột cuối khó xác định từ đầu thì dùng End(xlToLeft)

Chỉ cần mô tả dữ liệu mà không chịu làm thì bó tay ..................... toàn tập.

MinhKhai · 29/8/19

Chào các anh chị
Em có đoạn code cho chạy lặp đi lặp lại vô tận kiểu như sau:

Mã:

Sub VIDU()
My Code here
Application.OnTime Now + TimeValue("00:00:30"), "VIDU"
End Sub

Để dừng chạy Sub trên, em phải vào VBE để Break. Vậy các anh chị chỉ cách em tạo 1 Sub để Beak thay vì phải vào VBE.
Em xin cảm ơn

Thanh1102 · 30/8/19

batman1 đã viết:
Nếu có trường hợp tôi nói thì còn ngạc nhiên gì nữa? Vì lúc đó sArr và dArr luôn có 16384 cột và duyệt chúng, rồi đập mảng 12000 dòng và 16384 cột xuống sheet lâu là đương nhiên.

Nếu trong tất cả các sheet cột cuối cùng có dữ liệu ở dòng 11 KHÔNG BAO GIỜ vượt quá AV (AZ, BB ...) thì lấy luôn từ A tới AV chứ bầy trò Ws.[AV11].End(2).Column để làm gì?

Còn nếu cột cuối khó xác định từ đầu thì dùng End(xlToLeft)

Chỉ cần mô tả dữ liệu mà không chịu làm thì bó tay ..................... toàn tập.

Cảm ơn bạn. Mình đang tập tọe VBA nên không rõ.
Trong dữ liệu của từng sheet đều cố định cột từ A đến AV và đều bắt đầu từ dòng 11. Tuy nhiên đúng như bạn nói. Có 1 số cột nằm giữa A và AV trống không có dữ liệu và có 1 số dòng trống trong các sheet.
Để tối ưu hơn mình gửi file đính kèm. Bạn xem giúp mình nhé.

SA_DQ · 30/8/19

Trong dữ liệu của từng sheet đều cố định cột từ A đến AV và đều bắt đầu từ dòng 11. Tuy nhiên đúng như bạn nói. Có 1 số cột nằm giữa A và AV trống không có dữ liệu và có 1 số dòng trống trong các sheet.
Để tối ưu hơn mình gửi file đính kèm.

Mình chạy Code của bạn đang dính lỗi này: ReDim dArr(1 To Tong, 1 To Max)
Nếu rà chuột vô tham biếm 'Max' nó đang chứa trị 16.384
Nhưng các trang của bạn không quá 52 cột. Như vậy chúng tỏ macro còn lỗi trong việc xác định số cột trong từng trang tính.
Bạn nên tìm lỗi này & trừ khử đi
Còn nếu đúng trình độ VBA của bạn trung bình thì cách này không cần kiến thức mảng gì sất, tuy chậm hơn nhưng chắc không sai:

B1: Tạo vòng lặp duyệt qua các trang (Bạn đã làm)
B2 Xác dịnh vùng dữ liệu cần chép của trang đang duyệt (Rng)
B3: Copy sang 'Total':
B3.1 Xác định dòng cuối có dữ liệu của 'Total (ví dụ là lRow)
B3.2: Thực hiện Copy vùng dữ liệu cần chép sang 'Total': Rng.Copy Destination:=Sheets("Total")..Cells(lRow,"A")

Bạn đừng nghỉ là mình sẽ viết macro xử lý cho bạn nha: Vì dữ liệu của bạn như thể đống rác như vậy mình không dám đụng đâu!

lehuuhaint · 30/8/19

Xin chào mọi người !
Nhờ mọi người giúp đỡ vấn đề như sau :
Em gửi thư hàng loạt bằng VBA qua out look nhưng gặp vấn đề là văn bản em soạn thảo trên excel không thể soạn một cái mail đẹp đẹp xíu ( kiểu chữ, canh lề chuẩn, Tô màu các điểm cần chú ý, xuống dòng, và im đậm, in nghiêng ..)
Anh chị có thể cho em hướng giải quyết về vấn đề này được ko ?

batman1 · 30/8/19

Thanh1102 đã viết:
Cảm ơn bạn. Mình đang tập tọe VBA nên không rõ.
Trong dữ liệu của từng sheet đều cố định cột từ A đến AV và đều bắt đầu từ dòng 11. Tuy nhiên đúng như bạn nói. Có 1 số cột nằm giữa A và AV trống không có dữ liệu và có 1 số dòng trống trong các sheet.
Để tối ưu hơn mình gửi file đính kèm. Bạn xem giúp mình nhé.

Công nhận là máy bạn khủng thật. Tôi chạy code của bạn snow thì không chạy được vì mảng dArr quá lớn. Cũng phải thôi vì mảng dArr có 10329 dòng và 16384 cột, tức có 10329*16384 = 169230336 phần tử. Mà mỗi phần tử ngốn 16 bai (Variant) nên mảng dArr chiếm 2 707 685 376 bai > 2 GB. Trong khi đó 2 máy tôi chỉ có 1 GB và 4 GB RAM, mà một số lớn đã chiếm bởi system và các chương trình mặc định.

Tôi đã nói rõ: Nếu trong mọi sheet dữ liệu không vượt quá cột AV thì ta luôn lấytới AV và không chơi trò Ws.[AV11].End(2).Column nữa. Mà nếu đã chơi trò END thì phải là End(xlToLeft)

Tôi chỉ sửa code của bạn snow để bạn thấy khi mảng giảm cân nhiều thì sẽ thế nào. Còn giải pháp của bạn SA_DQ thì coi như bài tập về nhà cho bạn. Nhưng nếu đúng là "Mình đang tập tọe VBA" thì bài tập quá khó với bạn đấy. Tôi không tin là trên cơ sở mấy gợi ý đó bạn sẽ tự hoàn thành được bài tập đó.

Mã:

Public Sub Noisheet()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> "Sum" Then
            If Ws.Name <> "Total" Then
                tong = tong + Ws.Range("B" & Rows.Count).End(xlUp).Row - 10
            End If
        End If
    Next
    If tong = 0 Or tong > Rows.Count Then
        If tong > Rows.Count Then MsgBox "nhieu dong qua"
        Exit Sub
    End If
    ReDim dArr(1 To tong, 1 To 48)     '   lay tu A toi AV = 48 cot
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> "Sum" Then
            If Ws.Name <> "Total" Then
                I = Ws.Cells(Rows.Count, "B").End(xlUp).Row
                If I > 10 Then
                    sArr = Ws.Range("A11:AV" & I).Value
                    For I = 1 To UBound(sArr, 1)
                        K = K + 1
                        For J = 1 To UBound(sArr, 2)
                            dArr(K, J) = sArr(I, J)
                        Next J
                    Next I
                End If
            End If
        End If
    Next
    With Sheets("Total")
        .Range("A7:AV" & Rows.Count).ClearContents
        .Range("A7").Resize(K, UBound(dArr, 2)).Value = dArr
    End With
End Sub

Tôi giữ nguyên code của bạn snow nhưng thực ra theo lôgíc thì xóa dữ liệu cũ phải làm ngay từ đầu. Vì sao? Vì nếu để như bây giờ và nếu có tong > Rows.Count thì code sẽ thoát Sub mà không xóa dữ liệu cũ. Người dùng sẽ "tưởng" đó là kết quả mới.

Thanh1102 · 30/8/19

SA_DQ đã viết:
Mình chạy Code của bạn đang dính lỗi này: ReDim dArr(1 To Tong, 1 To Max)
Nếu rà chuột vô tham biếm 'Max' nó đang chứa trị 16.384
Nhưng các trang của bạn không quá 52 cột. Như vậy chúng tỏ macro còn lỗi trong việc xác định số cột trong từng trang tính.
Bạn nên tìm lỗi này & trừ khử đi
Còn nếu đúng trình độ VBA của bạn trung bình thì cách này không cần kiến thức mảng gì sất, tuy chậm hơn nhưng chắc không sai:

B1: Tạo vòng lặp duyệt qua các trang (Bạn đã làm)
B2 Xác dịnh vùng dữ liệu cần chép của trang đang duyệt (Rng)
B3: Copy sang 'Total':
B3.1 Xác định dòng cuối có dữ liệu của 'Total (ví dụ là lRow)
B3.2: Thực hiện Copy vùng dữ liệu cần chép sang 'Total': Rng.Copy Destination:=Sheets("Total")..Cells(lRow,"A")

Bạn đừng nghỉ là mình sẽ viết macro xử lý cho bạn nha: Vì dữ liệu của bạn như thể đống rác như vậy mình không dám đụng đâu!

batman1 đã viết:
Công nhận là máy bạn khủng thật. Tôi chạy code của bạn snow thì không chạy được vì mảng dArr quá lớn. Cũng phải thôi vì mảng dArr có 10329 dòng và 16384 cột, tức có 10329*16384 = 169230336 phần tử. Mà mỗi phần tử ngốn 16 bai (Variant) nên mảng dArr chiếm 2 707 685 376 bai > 2 GB. Trong khi đó 2 máy tôi chỉ có 1 GB và 4 GB RAM, mà một số lớn đã chiếm bởi system và các chương trình mặc định.

Tôi đã nói rõ: Nếu trong mọi sheet dữ liệu không vượt quá cột AV thì ta luôn lấytới AV và không chơi trò Ws.[AV11].End(2).Column nữa. Mà nếu đã chơi trò END thì phải là End(xlToLeft)

Tôi chỉ sửa code của bạn snow để bạn thấy khi mảng giảm cân nhiều thì sẽ thế nào. Còn giải pháp của bạn SA_DQ thì coi như bài tập về nhà cho bạn. Nhưng nếu đúng là "Mình đang tập tọe VBA" thì bài tập quá khó với bạn đấy. Tôi không tin là trên cơ sở mấy gợi ý đó bạn sẽ tự hoàn thành được bài tập đó.

Mã:

Public Sub Noisheet() Dim sArr(), dArr(), I As Long, J As Long, K As Long, Col As Long, Ws As Worksheet, tong As Long For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "Sum" Then If Ws.Name <> "Total" Then tong = tong + Ws.Range("B" & Rows.Count).End(xlUp).Row - 10 End If End If Next If tong = 0 Or tong > Rows.Count Then If tong > Rows.Count Then MsgBox "nhieu dong qua" Exit Sub End If ReDim dArr(1 To tong, 1 To 48) ' lay tu A toi AV = 48 cot For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "Sum" Then If Ws.Name <> "Total" Then I = Ws.Cells(Rows.Count, "B").End(xlUp).Row If I > 10 Then sArr = Ws.Range("A11:AV" & I).Value For I = 1 To UBound(sArr, 1) K = K + 1 For J = 1 To UBound(sArr, 2) dArr(K, J) = sArr(I, J) Next J Next I End If End If End If Next With Sheets("Total") .Range("A7:AV" & Rows.Count).ClearContents .Range("A7").Resize(K, UBound(dArr, 2)).Value = dArr End With End Sub

Tôi giữ nguyên code của bạn snow nhưng thực ra theo lôgíc thì xóa dữ liệu cũ phải làm ngay từ đầu. Vì sao? Vì nếu để như bây giờ và nếu có tong > Rows.Count thì code sẽ thoát Sub mà không xóa dữ liệu cũ. Người dùng sẽ "tưởng" đó là kết quả mới.

Cảm ơn bạn batman1 đã nhiệt tình hỗ trợ và bạn SA_DQ như mình đã nói mình đang tập tọe VBA mà và đúng là quá khó với mình sau gợi ý của bạn SA_DQ nhưng mình sẽ cố gắng học hỏi thêm. Chúc hai bạn vui khỏe.

VetMini · 30/8/19

batman1 đã viết:
...
Tôi giữ nguyên code của bạn snow nhưng thực ra theo lôgíc thì xóa dữ liệu cũ phải làm ngay từ đầu. Vì sao? Vì nếu để như bây giờ và nếu có tong > Rows.Count thì code sẽ thoát Sub mà không xóa dữ liệu cũ. Người dùng sẽ "tưởng" đó là kết quả mới.

Cái vấn đề này tôi nhắc hoài nhưng hình như bà con ở GPE này không quan tâm.
Nguyên tắc cần thiết của tổng hợp dữ liệu khủng (vài ngàn dòng là khủng rồi) là phải có log ghi lại.
Tối thiểu là phải có lời báo: "Sheet1 12345 dòng; Sheet2 6789 dòng, ...; tổng cộng 123456 dòng"
Nếu là tôi thì hoặc ghi hẳn số dòng ra một file text; hoặc ghi xuất xứ vào cột A (từ dòng 1 đến 12345 là "Sheet1";...) và sau khi kiểm chứng xong, xóa cột.

Nhưng ở đây, tôi thấy tối đa là người ta có một cái message "Done!". Chưa kể nhiều người còn code để gặp vấn đề thì nó vượt qua luôn. Tôi thực sự không hiểu khi chép chỉ 9 sheets mà không biết rằng đáng lẽ phải là 10 thì chép làm cái gì?

batman1 · 30/8/19

Thanh1102 đã viết:
Cảm ơn bạn batman1 đã nhiệt tình hỗ trợ

Nhưng bây giờ tốc độ thế nào?

tuangiang25022008 · 31/8/19

Em có 1 file muốn nhờ các anh chị em trên diễn đàn viết đoạn code tìm điều kiện theo mảng cho em.
Nói ra rất dài dòng nên em có nêu yêu cầu ở trong ảnh và em có đưa file lên rồi.

Mong sớm được anh chị em trên diễn đàn giúp đỡ.
Thân!

Bài đã được tự động gộp: 31/8/19

tuangiang25022008 đã viết:
Em có 1 file muốn nhờ các anh chị em trên diễn đàn viết đoạn code tìm điều kiện theo mảng cho em.
Nói ra rất dài dòng nên em có nêu yêu cầu ở trong ảnh và em có đưa file lên rồi.

Mong sớm được anh chị em trên diễn đàn giúp đỡ.
Thân!

phulien1902 · 31/8/19

tuangiang25022008 đã viết:
Em có 1 file muốn nhờ các anh chị em trên diễn đàn viết đoạn code tìm điều kiện theo mảng cho em.
Nói ra rất dài dòng nên em có nêu yêu cầu ở trong ảnh và em có đưa file lên rồi.

Mong sớm được anh chị em trên diễn đàn giúp đỡ.
Thân!

Bài đã được tự động gộp: 31/8/19

Bạn thử:

PHP:

Sub Test()
    Dim i%, j%, LR&
    LR = ActiveSheet.Range("A10000").End(xlUp).Row
    For i = 4 To LR
        For j = 3 To 11
            If Cells(i, 1) <= Cells(i, j) Then
                Cells(i, 2) = "Lên l" & ChrW(7899) & "p"
                Exit For
            ElseIf Cells(i, 1) > Cells(i, j) Then
                Cells(i, 2) = ChrW(7902) & " l" & ChrW(7841) & "i l" & ChrW(7899) & "p"
            End If
        Next
    Next
End Sub

tuangiang25022008 · 31/8/19

phulien1902 đã viết:

Bạn thử:

PHP:

Sub Test()
    Dim i%, j%, LR&
    LR = ActiveSheet.Range("A10000").End(xlUp).Row
    For i = 4 To LR
        For j = 3 To 11
            If Cells(i, 1) <= Cells(i, j) Then
                Cells(i, 2) = "Lên l" & ChrW(7899) & "p"
                Exit For
            ElseIf Cells(i, 1) > Cells(i, j) Then
                Cells(i, 2) = ChrW(7902) & " l" & ChrW(7841) & "i l" & ChrW(7899) & "p"
            End If
        Next
    Next
End Sub

Cám ơn anh nhiều. Đúng ý của em rồi.
Chúc các anh, chị em sức khỏe và thành đạt.
Thân!

kevinpham1225 · 2/9/19

Xin giúp mình tăng tốc độ xử lý VBA, vì khi nhập 1 dữ liệu tại 1 cell của sheet nguồn, enter nó sẽ mất khoảng 5-7s cho 1 thao tác. File nặng khoảng 12MB.

Cụ thể:
- Sheet nguồn nhập, thay đổi dữ liệu: "2019"
- Sheet lọc dữ liệu từ sheet nguồn: "Ton", "No", "Phat sinh", "Loi nhuan".

Mục đích: tự động Repply filter cho các sheet cần lọc dữ liệu khi nhập hoặc thay đổi giá trị dữ liệu từ Sheet nguồn "2019".

- Đoạn mã (được áp vào module của sheet "2019"):

Private Sub Worksheet_Change(ByVal Target As Range)

Sheets("2019").AutoFilter.ApplyFilter
Sheets("Ton").AutoFilter.ApplyFilter
Sheets("No").AutoFilter.ApplyFilter
Sheets("Phat sinh").AutoFilter.ApplyFilter
Sheets("Loi nhuan").AutoFilter.ApplyFilter

End Sub

Mong các bạn chỉ giúp cách cải thiện tốc độ xử lý; Hoặc viết giúp đoạn code nào xử lý nhanh với mục đích tự động Repply Filter tại các sheet cần lọc khi thay đổi dữ liệu từ sheet nguồn.
Cảm ơn !

VetMini · 2/9/19

Lại cái tật một bài đăng hai chỗ.
Thành viên hơn 5 năm gì mà chả biết lịch sự căn bản.

Duc Phuc · 4/9/19

Hi anh chị, em mới tìm hiểu về VBA, nên chưa có nhiều kinh nghiệm, mong các anh chị chỉ bảo.
Em đang có 1 bài tập như trong file.
Hiện e không biết sử dụng vòng lặp VBA như thế nào để thực hiện.
Hiện e có thể sử dụng hàm thủ công sumif và countif .
Yêu cầu:
Tính số ngày hàng về ( lots ) và tổng số lượng hàng về ( pcs )

Cảm ơn anh chị !

phulien1902 · 4/9/19

Duc Phuc đã viết:
Hi anh chị, em mới tìm hiểu về VBA, nên chưa có nhiều kinh nghiệm, mong các anh chị chỉ bảo.
Em đang có 1 bài tập như trong file.
Hiện e không biết sử dụng vòng lặp VBA như thế nào để thực hiện.
Hiện e có thể sử dụng hàm thủ công sumif và countif .
Yêu cầu:
Tính số ngày hàng về ( lots ) và tổng số lượng hàng về ( pcs )

Cảm ơn anh chị !

1 cách:

PHP:

Sub Test()
    Dim LR As Long
    LR = Range("B" & Rows.Count).End(xlUp).Row
    [L3] = WorksheetFunction.CountIf(Range("C3:C" & LR), Range("K3"))
    [M3] = WorksheetFunction.SumIf(Range("C3:C" & LR), Range("K3"), Range("D3:D" & LR))
End Sub

Duc Phuc · 4/9/19

phulien1902 đã viết:

1 cách:

PHP:

Sub Test()
    Dim LR As Long
    LR = Range("B" & Rows.Count).End(xlUp).Row
    [L3] = WorksheetFunction.CountIf(Range("C3:C" & LR), Range("K3"))
    [M3] = WorksheetFunction.SumIf(Range("C3:C" & LR), Range("K3"), Range("D3:D" & LR))
End Sub

OK tks a . Để e tìm hiểu thêm .

LYSM · 4/9/19

Em chào các anh chị!
Em có code lấy dữ liệu từ 1 workbook khác như bên dưới, nhưng khi vận hành nếu sarr(1,j) (j =25 to 28) có số ký tự >255 thì nó chỉ lấy đến 255 ký tự thôi ạ, cụ thể là file "An" trong cell B26 sẽ bị bỏ bớt nội dung khi sang file "z File Tong hop". Mong các anh chị giúp đỡ ạ, code này em đi xin bác snow25 nên không hiểu bản chất. Em cám ơn!

Mã:

Sub tonghop()

     Application.ScreenUpdating = False

     Application.AskToUpdateLinks = False

     Application.DisplayAlerts = False

     Dim cn As Object, sqlStr As String, i As Long, lr As Long, k, rst As Object, Pro As String, ext As String, arr(1 To 1000, 1 To 14), a As Long

     Dim sarr, j As Long

     Set cn = CreateObject("ADODB.Connection")

     Set rst = CreateObject("ADODB.recordset")

     With Application.FileDialog(msoFileDialogFilePicker)

         .AllowMultiSelect = True

    If Not .Show = -1 Then Exit Sub

    For Each k In .SelectedItems

       Pro = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="

       ext = ";Extended Properties=""Excel 12.0;HDR=yes;IMEX= 1"";"

       cn.Open (Pro & k & ext)

       sqlStr = "Select * From [sheet1$a1:e30]"

       sarr = cn.Execute(sqlStr).GetRows

       a = a + 1

       arr(a, 1) = a

       arr(a, 2) = sarr(1, 3)

       arr(a, 3) = sarr(1, 0)

       arr(a, 4) = sarr(1, 2)

       arr(a, 5) = sarr(1, 1)

       arr(a, 9) = sarr(4, 7)

       arr(a, 10) = sarr(4, 8)

       arr(a, 11) = sarr(4, 9)

       arr(a, 12) = sarr(4, 10)

       arr(a, 13) = sarr(4, 11)

       arr(a, 14) = sarr(1, 24)

       For j = 25 To 28

          If sarr(1, j) <> Empty Then arr(a, 14) = arr(a, 14) & Chr(10) & sarr(1, j)

       Next j

       cn.Close

    Next

    End With

    With Sheets("sheet1")

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

         If lr > 12 Then .Range("A13:N" & lr).ClearContents

         If a Then .Range("A13:N13").Resize(a).Value = arr

     End With

End Sub

Duc Phuc · 8/9/19

Cảm ơn anh chị đã giải đáp bài tập hôm bữa, Nay em lại xin nhờ anh chị giải đáp tiếp 1 bài tập như sau. Bài tập này bổ sung bài tập trước.

Yêu cầu: Đếm xem từng vật liệu có bao nhiêu ngày về trong tháng và tổng lượng hàng về trong tháng. ( có ngày về 2 lần, nên sẽ trùng ngày )

VetMini · 8/9/19

Đây là thớt "thắc mắc về code". Giành cho những người viết code và cần được chỉ dẫn chỗ bí hoặc thắc mắc.

Bài tập cần làm giùm thì đem qua thớt "thành viên giúp nhau" mà nhờ.

Duc Phuc · 8/9/19

VetMini đã viết:
Đây là thớt "thắc mắc về code". Giành cho những người viết code và cần được chỉ dẫn chỗ bí hoặc thắc mắc.

Bài tập cần làm giùm thì đem qua thớt "thành viên giúp nhau" mà nhờ.

Ok a .

25xuanquang · 26/9/19

Các cụ cho em hỏi dòng code này sai ở đâu ạ

Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"

Nếu em để dạng tex thì như này lại đúng:
Sheet1.Range("G2").Formula = "=E2="""& Sheet4.Range("B1") & """"

Code full đây ạ T___T
Sub Search_BDS()

Sheet4.Range("A3:F1000").Clear
Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"
Sheet1.Range("A1:F67010").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheet1.Range("G1:G2"), CopyToRange:=Sheet4.Range("A3"), _
Unique:=False
End Sub

snow25 · 26/9/19

25xuanquang đã viết:
Các cụ cho em hỏi dòng code này sai ở đâu ạ
Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"

Nếu em để dạng tex thì như này lại đúng:
Sheet1.Range("G2").Formula = "=E2="""& Sheet4.Range("B1") & """"

Code full đây ạ T___T
Sub Search_BDS()

Sheet4.Range("A3:F1000").Clear
Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"
Sheet1.Range("A1:F67010").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheet1.Range("G1:G2"), CopyToRange:=Sheet4.Range("A3"), _
Unique:=False
End Sub

Bạn chạy debug 2 câu lệnh xem nó có gì khác nhau là biết.

batman1 · 26/9/19

snow25 đã viết:
Bạn chạy debug 2 câu lệnh xem nó có gì khác nhau là biết.

Khác nhau thì dễ rồi. Nhưng hỏi kiểu đó thì đoán mò hơi mệt.

Rất có thể là

Mã:

Sheet1.Range("G2").Formula = "=E2=Sheet4!B1"

25xuanquang · 27/9/19

Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"
VBA báo đỏ mng ạ
Ý của em là muốn ô G2 đc gán công thức là =E2=B1 (của sheet 4 ạ) trả về kết quả true hoặc false

phulien1902 · 27/9/19

25xuanquang đã viết:
Sheet1.Range("G2").Formula = "=E2= Sheet4.Range("B1")"
VBA báo đỏ mng ạ
Ý của em là muốn ô G2 đc gán công thức là =E2=B1 (của sheet 4 ạ) trả về kết quả true hoặc false

Bài #2296 với dòng Code đó hoàn toàn đúng, nếu sai là do người dùng mà thôi.

Thanh1102 · 27/9/19

batman1 đã viết:
Nhưng bây giờ tốc độ thế nào?

Tốt hơn nhiều rồi bạn ạ. Cảm ơn bạn nhiều

Tăng Vĩnh Hòa · 28/9/19

Các Thầy cho em hỏi có đoạn code nào có thể enable protect view và enable contents ngay khi mở file *.xlsm không ạ?
Em muốn chạy 1 sự kiện open workbook ngay khi vừa mở file lên mà không cần phải click enable lên 2 thanh màu vàng khi mở file.
Em muốn dùng code để thực hiện mà không phải vào excel option để chỉnh lại phần trust, vì file có thể gửi cho người khác sử dụng.
Mong nhận được phản hồi của các Thầy. Em cảm ơn!

VetMini · 28/9/19

Tăng Vĩnh Hòa đã viết:
Các Thầy cho em hỏi có đoạn code nào có thể enable protect view và enable contents ngay khi mở file *.xlsm không ạ?
Em muốn chạy 1 sự kiện open workbook ngay khi vừa mở file lên mà không cần phải click enable lên 2 thanh màu vàng khi mở file.
Em muốn dùng code để thực hiện mà không phải vào excel option để chỉnh lại phần trust, vì file có thể gửi cho người khác sử dụng.
Mong nhận được phản hồi của các Thầy. Em cảm ơn!

Cái bạn muốn đó cũng là cái mà bọn viết vi rút muốn.
"chỉnh lại phần trust" là nguyên tắc căn bản để người ta tránh vi rút. Bi giờ nếu VBA nó có khả năng vượt qua chỗ đó thì hỏi còn gì để bảo vệ ngừoi dùng nữa.

Tôi không nói là không làm được. Nhưng cái bạn muốn đó thuộc về kỹ thuật đặt vi rút.
Cách chân thức để truyền bá files có macros là dùng "digital signature"

thanhduc1986 · 30/9/19

Xin chào mọi người. Kính nhờ các anh chị chỉ giúp mình 1 đoạn code về tìm ngày trong dữ liệu.
Giả sử cột A chứa dữ liệu dạng Date, format dd/mm/yyyy, sắp xếp tăng dần (các giá trị có thể không liên tục, có thể có nhiều dòng có cùng giá trị).
Yêu cầu là tìm một ngày X cho trước (ví dụ ở ô C2) trong cột A và trả về kết quả là dòng đầu tiên có dữ liệu là ngày X. Nếu không tìm thấy thì trả về kết quả là dòng đầu tiên của ngày gần nhất sau ngày X.
Ví dụ như hình đính kèm nhé.
Cám ơn cả nhà.

snow25 · 30/9/19

thanhduc1986 đã viết:
Xin chào mọi người. Kính nhờ các anh chị chỉ giúp mình 1 đoạn code về tìm ngày trong dữ liệu.
Giả sử cột A chứa dữ liệu dạng Date, format dd/mm/yyyy, sắp xếp tăng dần (các giá trị có thể không liên tục, có thể có nhiều dòng có cùng giá trị).
Yêu cầu là tìm một ngày X cho trước (ví dụ ở ô C2) trong cột A và trả về kết quả là dòng đầu tiên có dữ liệu là ngày X. Nếu không tìm thấy thì trả về kết quả là dòng đầu tiên của ngày gần nhất sau ngày X.
Ví dụ như hình đính kèm nhé.
Cám ơn cả nhà.

Cái này có phải là thắc mắc về code đâu.Đây là hỏi bài mà bạn.

msfbtvt · 1/10/19

Chào mọi người,
E mới tìm hiểu về VBA.
Khi e làm record Macrođể thực thi một số thao tác đơn giản thì thấy VBA không chạy với sheet tên Tiếng Việt.
Có cách nào để xử lý đơn gian nhất không ạ, mong mọi người giúp e.

phulien1902 · 1/10/19

msfbtvt đã viết:
Chào mọi người,
E mới tìm hiểu về VBA.
Khi e làm record Macrođể thực thi một số thao tác đơn giản thì thấy VBA không chạy với sheet tên Tiếng Việt.
Có cách nào để xử lý đơn gian nhất không ạ, mong mọi người giúp e.View attachment 225920

Bạn đổi tên sheet từ dạng tiếng Việt có dấu về dạng không dấu.

batman1 · 1/10/19

Không phải là Sheets("Nh" & ChrW(7853) & "p"").select mà là Sheets("Nh" & ChrW(7853) & "p").select

Nếu vẫn báo lỗi thì ắt là tên sheet và chuỗi "Nh" & ChrW(7853) & "p" là 2 loại unicode khác nhau - một là unicode dựng sẵn còn cái kia là unicode tổ hợp.

Mà tốt nhất nên dùng tên sheet không dấu.

kokano90 · 2/10/19

Chao các anh chị
Em có đoạn code sưu tầm trên GPE về tạo PivotTable

Ngồi ngẫm cả chiều mà chưa biết nên làm thế nào.
Khu vực khoanh đỏ là phần PivotTable được tạo trên sheet mới toanh. Em muốn PivotTable được tạo trên Sheet chỉ đinh sẵn (Chẳng hạn sheet TONGHOP) Thì sửa thế nào ạ
Em có gửi file đính kèm.
Cảm ơn các anh chị nhiều ạ

ppc0312 · 2/10/19

kokano90 đã viết:
Chao các anh chị
Em có đoạn code sưu tầm trên GPE về tạo PivotTable
View attachment 226007
Ngồi ngẫm cả chiều mà chưa biết nên làm thế nào.
Khu vực khoanh đỏ là phần PivotTable được tạo trên sheet mới toanh. Em muốn PivotTable được tạo trên Sheet chỉ đinh sẵn (Chẳng hạn sheet TONGHOP) Thì sửa thế nào ạ
Em có gửi file đính kèm.
Cảm ơn các anh chị nhiều ạ

Thử thay thành
"TONGHOP!R5C1"

Và sau đó thay tất cả ActiveSheet thành Sheets("TONGHOP")

xem nó đi đâu về đâu

phulien1902 · 2/10/19

kokano90 đã viết:
Chao các anh chị
Em có đoạn code sưu tầm trên GPE về tạo PivotTable
View attachment 226007
Ngồi ngẫm cả chiều mà chưa biết nên làm thế nào.
Khu vực khoanh đỏ là phần PivotTable được tạo trên sheet mới toanh. Em muốn PivotTable được tạo trên Sheet chỉ đinh sẵn (Chẳng hạn sheet TONGHOP) Thì sửa thế nào ạ
Em có gửi file đính kèm.
Cảm ơn các anh chị nhiều ạ

Có 1 cách là bạn thêm dòng dưới đây vào Code của bạn:

PHP:

ActiveSheet.Range("A1").CurrentRegion.Copy Sheets("TONGHOP").Range("A1")

kokano90 · 2/10/19

ppc0312 đã viết:
Thử thay thành
"TONGHOP!R5C1"

Và sau đó thay tất cả ActiveSheet thành Sheets("TONGHOP")

xem nó đi đâu về đâu

Cám ơn anh đã phản hồi ạ. Nhưng sau khi thay xong nó vẫn báo lỗi ạ

Bài đã được tự động gộp: 2/10/19

phulien1902 đã viết:
Có 1 cách là bạn thêm dòng dưới đây vào Code của bạn:

PHP:

ActiveSheet.Range("A1").CurrentRegion.Copy Sheets("TONGHOP").Range("A1")

cảm ơn anh đã giúp ạ. ý anh à copy dữ liệu sang sheet TONG HOP ấy ạ

ppc0312 · 2/10/19

kokano90 đã viết:
View attachment 226013
Cám ơn anh đã phản hồi ạ. Nhưng sau khi thay xong nó vẫn báo lỗi ạ

Bài đã được tự động gộp: 2/10/19

cảm ơn anh đã giúp ạ. ý anh à copy dữ liệu sang sheet TONG HOP ấy ạ

Phải xóa sạch pivot table đó ở sheet TONGHOP trước khi chạy (thủ công hay code thì tùy)

kokano90 · 2/10/19

ppc0312 đã viết:
Phải xóa sạch pivot table đó ở sheet TONGHOP trước khi chạy (thủ công hay code thì tùy)

cảm ơn anh và anh @phulien1902 nhiều ạ. Đã ra kết quả mong muốn rồi ạ

AnhThu-1976 · 4/10/19

Em muốn duyệt qua các sheet có tên là aaa, rồi đến bbb
Thì đoạn code dưới thì đúng

Mã:

 For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name = "aaa" Or Sh.Name = "bbb" Then

Bây giờ em muốn để nó trong Array

Mã:

For Each Sh In ThisWorkbook.Worksheets
      If Sh.Name = Array("aaa", "bbb") Then

thì nó báo lỗi Type mismath
Bây giờ em muốn để các Sheet trong Array được không? và code sửa như thế nào
p/s: em muốn làm như trên cho gọn vì em có rất nhiều sheet để duyệt
Em cảm ơn

phulien1902 · 4/10/19

AnhThu-1976 đã viết:
Em muốn duyệt qua các sheet có tên là aaa, rồi đến bbb
Thì đoạn code dưới thì đúng

Mã:

For Each Sh In ThisWorkbook.Worksheets If Sh.Name = "aaa" Or Sh.Name = "bbb" Then

Bây giờ em muốn để nó trong Array

Mã:

For Each Sh In ThisWorkbook.Worksheets If Sh.Name = Array("aaa", "bbb") Then

thì nó báo lỗi Type mismath
Bây giờ em muốn để các Sheet trong Array được không? và code sửa như thế nào
p/s: em muốn làm như trên cho gọn vì em có rất nhiều sheet để duyệt
Em cảm ơn

Bạn thử:

PHP:

 arr = Array("aaa", "bbb", "ccc", "...")
    For i = 1 To Sheets.Count
        '------------------------
    Next i

Hoặc:

PHP:

        For Each i In Array("aaa", "bbb", "ccc", "...")
            '----------------
        Next

phatgtvt · 6/10/19

Kính chào các anh, chị;
Em mới tập tành VBA nên không biết xử lý vấn đề này sao. Các anh, chị biết xử lý giúp e nha. E nghiên cứu mãi mà không được. Các anh, chị chỉnh sửa dùm e nha. Cám ơn các anh, chị nhiều.

VetMini · 6/10/19

phulien1902 đã viết:
Bạn thử:

PHP:

arr = Array("aaa", "bbb", "ccc", "...") For i = 1 To Sheets.Count '------------------------ Next i

Hoặc:

PHP:

For Each i In Array("aaa", "bbb", "ccc", "...") '---------------- Next

Câu trả lời của bạn chỉ giải quyết vấn đề bằng cách khác, chứ không trực tiếp theo chiều hướng người hỏi.

để các Sheet trong Array được không? và code sửa như thế nào
For Each Sh In Array(Sheets("aaa"), Sheets("bbb"), ...)
...
Next Sh

SA_DQ · 6/10/19

Em mới tập tành VBA nên không biết xử lý vấn đề này sao. Các anh, chị biết xử lý giúp e nha. E nghiên cứu mãi mà không được. Các anh, chị chỉnh sửa dùm e nha.

PHP:

Private Sub UserForm_Activate()
Me.Caption = "KE HOACH CONG VIEC DEN NGAY " & Format(Now(), "dd/mm/yyyy")
Sheets("Weekend Plan").Select
Dim AsOFDate, AsOfWeek As String, MaxARRow, MaxARColumn, ListQuaHanRow, ListDenHanRow As Integer
AsOFDate = Format(Now(), "mm/DD/yyyy")      'AsOFDate = Format(Now(), "dd/mm/yyyy") '
AsOfWeek = Format(Now() + 7, "mm/DD/yyyy")  'AsOfWeek = Format(Now() + 7, "dd/mm/yyyy") '
MaxARRow = Range("MaxARRow")
MaxARColumn = Range("MaxARColumn")
ListQuaHanRow = 0:                              ListDenHanRow = 0
Me.ListQuaHan.Clear:                            Me.ListDenHan.Clear
'Loc Phát Sinh Quá Han  '
Me.MultiPage1.Value = 0
For i = 2 To MaxARRow
    If Format(Cells(i, 5), "mm/DD/yyyy") < AsOFDate Then
        Me.ListQuaHan.AddItem (Cells(i, 1))
        Me.ListQuaHan.List(ListQuaHanRow, 1) = Cells(i, 2)
        Me.ListQuaHan.List(ListQuaHanRow, 2) = Cells(i, 3)
        Me.ListQuaHan.List(ListQuaHanRow, 3) = Format(Cells(i, 4), "#,###,###")
        Me.ListQuaHan.List(ListQuaHanRow, 4) = Cells(i, 5)
        Me.ListQuaHan.List(ListQuaHanRow, 5) = Cells(i, 6)
        ListQuaHanRow = ListQuaHanRow + 1
    End If
Next i
'Loc Phát Sinh Dén Han: '
Me.MultiPage1.Value = 1
For j = 2 To MaxARRow
    If Format(Cells(j, 5), "mm/DD/yyyy") >= AsOFDate And Format(Cells(j, 5), "mm/DD/yyyy") <= AsOfWeek Then '** '
        Me.ListDenHan.AddItem (Cells(j, 1))
        Me.ListDenHan.List(ListDenHanRow, 1) = Cells(j, 2)
        Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
        Me.ListDenHan.List(ListDenHanRow, 3) = Format(Cells(j, 4), "#,###,###")
        Me.ListDenHan.List(ListDenHanRow, 4) = Cells(j, 5)
        Me.ListDenHan.List(ListDenHanRow, 5) = Cells(j, 6)
        ListDenHanRow = ListDenHanRow + 1
    End If
Next j
End Sub

batman1 · 6/10/19

phatgtvt đã viết:
Em mới tập tành VBA nên không biết xử lý vấn đề này sao. Các anh, chị biết xử lý giúp e nha. E nghiên cứu mãi mà không được. Các anh, chị chỉnh sửa dùm e nha. Cám ơn các anh, chị nhiều.

Sai vì trong UserForm_Activate bạn so sánh chuỗi mà chuỗi lại không chuẩn.
Lấy vd.

Mã:

For i = 2 To MaxARRow
    If Format(Cells(i, 5), "dd/mm/yyyy") < AsOFDate Then
'    ...
    End If
Next i

Với i = 38 thì Cells(i, 5) là ngày 1 tháng 11 năm 2019. AsOFDate là 6 tháng 10 năm 2019 (ta chạy code ngày hôm nay)
Format(Cells(i, 5), "dd/mm/yyyy") = "01/11/2019"
AsOFDate = "06/10/2019".

Qui tắc so sánh chuỗi cùng chiều dài:
So sánh ký tự 1. Nếu không bằng nhau thì kết thúc và chuỗi có ký tự nhỏ hơn thì nhỏ hơn. Nếu bằng nhau thì so sánh ký tự 2. Tương tự nếu không bằng nhau thì kết thúc và chuỗi có ký tự nhỏ hơn thì nhỏ hơn. Nếu bằng nhau thì so sánh ký tự 3 v...v Nếu tất cả các ký tự bằng nhau thì 2 chuỗi bằng nhau.

Với qui tắc trên thì khi so sánh chuỗi "01/11/2019" và "06/10/2019" thì ở ký tự 2 ta có 1 < 6, vậy chuỗi "01/11/2019" < chuỗi "06/10/2019". Tức điều kiện cho IF thỏa và dòng 38 (STT = 37) được thêm vào ListBox. Tương tự với STT = 38-41, 67-71.

Cách khắc phục:
1. So sánh số.
Ngày tháng trong Excel là số nên so sánh số thôi. Tại sao phải biến thành chuỗi rồi so sánh chuỗi?

Mã:

Private Sub UserForm_Activate()
...
Dim AsOFDate As Long, AsOfWeek As Long, MaxARRow As Long, MaxARColumn As Long, ListQuaHanRow As Long, ListDenHanRow As Long
AsOFDate = Date
AsOfWeek = Date + 7
'    ...
For i = 2 To MaxARRow
    If Cells(i, 5) < AsOFDate Then
'    ...
    End If
Next i
...
For j = 2 To MaxARRow
    If Cells(j, 5) >= AsOFDate And Cells(j, 5) <= AsOfWeek Then
'    ...
    End If
Next j
End Sub

2. So sánh chuỗi (không khuyến cáo). Nếu thế thì dùng dạng "yyy/mm/dd". Dùng dạng này thì đúng.
Với vd. ở trên thì:
Format(Cells(i, 5), "dd/mm/yyyy") = "2019/11/01"
AsOFDate = "2019/10/06".
Và khi so sánh thì có "2019/11/01" > "2019/10/06" (so sánh kết thúc ở ký tự 7: 1 > 0)
Do vậy điều kiện không thỏa và dòng 38 (STT = 37) không được thêm vào ListBox

Mã:

Private Sub UserForm_Activate()
'    ...
Dim AsOFDate As String, AsOfWeek As String, MaxARRow As Long, MaxARColumn As Long, ListQuaHanRow As Long, ListDenHanRow As Long
AsOFDate = Format(Now(), "yyyy/mm/dd")
AsOfWeek = Format(Now() + 7, "yyyy/mm/dd")
'    ...
For i = 2 To MaxARRow
    If Format(Cells(i, 5), "yyyy/mm/dd") < AsOFDate Then
'    ...
    End If
Next i
...

For j = 2 To MaxARRow
    If Format(Cells(j, 5), "yyyy/mm/dd") >= AsOFDate And Format(Cells(j, 5), "yyyy/mm/dd") <= AsOfWeek Then
'    ...
    End If
Next j
End Sub

phatgtvt · 6/10/19

SA_DQ đã viết:

PHP:

Private Sub UserForm_Activate()
Me.Caption = "KE HOACH CONG VIEC DEN NGAY " & Format(Now(), "dd/mm/yyyy")
Sheets("Weekend Plan").Select
Dim AsOFDate, AsOfWeek As String, MaxARRow, MaxARColumn, ListQuaHanRow, ListDenHanRow As Integer
AsOFDate = Format(Now(), "mm/DD/yyyy")      'AsOFDate = Format(Now(), "dd/mm/yyyy") '
AsOfWeek = Format(Now() + 7, "mm/DD/yyyy")  'AsOfWeek = Format(Now() + 7, "dd/mm/yyyy") '
MaxARRow = Range("MaxARRow")
MaxARColumn = Range("MaxARColumn")
ListQuaHanRow = 0:                              ListDenHanRow = 0
Me.ListQuaHan.Clear:                            Me.ListDenHan.Clear
'Loc Phát Sinh Quá Han  '
Me.MultiPage1.Value = 0
For i = 2 To MaxARRow
    If Format(Cells(i, 5), "mm/DD/yyyy") < AsOFDate Then
        Me.ListQuaHan.AddItem (Cells(i, 1))
        Me.ListQuaHan.List(ListQuaHanRow, 1) = Cells(i, 2)
        Me.ListQuaHan.List(ListQuaHanRow, 2) = Cells(i, 3)
        Me.ListQuaHan.List(ListQuaHanRow, 3) = Format(Cells(i, 4), "#,###,###")
        Me.ListQuaHan.List(ListQuaHanRow, 4) = Cells(i, 5)
        Me.ListQuaHan.List(ListQuaHanRow, 5) = Cells(i, 6)
        ListQuaHanRow = ListQuaHanRow + 1
    End If
Next i
'Loc Phát Sinh Dén Han: '
Me.MultiPage1.Value = 1
For j = 2 To MaxARRow
    If Format(Cells(j, 5), "mm/DD/yyyy") >= AsOFDate And Format(Cells(j, 5), "mm/DD/yyyy") <= AsOfWeek Then '** '
        Me.ListDenHan.AddItem (Cells(j, 1))
        Me.ListDenHan.List(ListDenHanRow, 1) = Cells(j, 2)
        Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
        Me.ListDenHan.List(ListDenHanRow, 3) = Format(Cells(j, 4), "#,###,###")
        Me.ListDenHan.List(ListDenHanRow, 4) = Cells(j, 5)
        Me.ListDenHan.List(ListDenHanRow, 5) = Cells(j, 6)
        ListDenHanRow = ListDenHanRow + 1
    End If
Next j
End Sub

Được rồi nè. e cám ơn anh nhiều nha.

Bài đã được tự động gộp: 6/10/19

batman1 đã viết:
Sai vì trong UserForm_Activate bạn so sánh chuỗi mà chuỗi lại không chuẩn.
Lấy vd.

Mã:

For i = 2 To MaxARRow If Format(Cells(i, 5), "dd/mm/yyyy") < AsOFDate Then ' ... End If Next i

Với i = 38 thì Cells(i, 5) là ngày 1 tháng 11 năm 2019. AsOFDate là 6 tháng 10 năm 2019 (ta chạy code ngày hôm nay)
Format(Cells(i, 5), "dd/mm/yyyy") = "01/11/2019"
AsOFDate = "06/10/2019".

Qui tắc so sánh chuỗi cùng chiều dài:
So sánh ký tự 1. Nếu không bằng nhau thì kết thúc và chuỗi có ký tự nhỏ hơn thì nhỏ hơn. Nếu bằng nhau thì so sánh ký tự 2. Tương tự nếu không bằng nhau thì kết thúc và chuỗi có ký tự nhỏ hơn thì nhỏ hơn. Nếu bằng nhau thì so sánh ký tự 3 v...v Nếu tất cả các ký tự bằng nhau thì 2 chuỗi bằng nhau.

Với qui tắc trên thì khi so sánh chuỗi "01/11/2019" và "06/10/2019" thì ở ký tự 2 ta có 1 < 6, vậy chuỗi "01/11/2019" < chuỗi "06/10/2019". Tức điều kiện cho IF thỏa và dòng 38 (STT = 37) được thêm vào ListBox. Tương tự với STT = 38-41, 67-71.

Cách khắc phục:
1. So sánh số.
Ngày tháng trong Excel là số nên so sánh số thôi. Tại sao phải biến thành chuỗi rồi so sánh chuỗi?

Mã:

Private Sub UserForm_Activate() ... Dim AsOFDate As Long, AsOfWeek As Long, MaxARRow As Long, MaxARColumn As Long, ListQuaHanRow As Long, ListDenHanRow As Long AsOFDate = Date AsOfWeek = Date + 7 ' ... For i = 2 To MaxARRow If Cells(i, 5) < AsOFDate Then ' ... End If Next i ... For j = 2 To MaxARRow If Cells(j, 5) >= AsOFDate And Cells(j, 5) <= AsOfWeek Then ' ... End If Next j End Sub

2. So sánh chuỗi (không khuyến cáo). Nếu thế thì dùng dạng "yyy/mm/dd". Dùng dạng này thì đúng.
Với vd. ở trên thì:
Format(Cells(i, 5), "dd/mm/yyyy") = "2019/11/01"
AsOFDate = "2019/10/06".
Và khi so sánh thì có "2019/11/01" > "2019/10/06" (so sánh kết thúc ở ký tự 7: 1 > 0)
Do vậy điều kiện không thỏa và dòng 38 (STT = 37) không được thêm vào ListBox

Mã:

Private Sub UserForm_Activate() ' ... Dim AsOFDate As String, AsOfWeek As String, MaxARRow As Long, MaxARColumn As Long, ListQuaHanRow As Long, ListDenHanRow As Long AsOFDate = Format(Now(), "yyyy/mm/dd") AsOfWeek = Format(Now() + 7, "yyyy/mm/dd") ' ... For i = 2 To MaxARRow If Format(Cells(i, 5), "yyyy/mm/dd") < AsOFDate Then ' ... End If Next i ... For j = 2 To MaxARRow If Format(Cells(j, 5), "yyyy/mm/dd") >= AsOFDate And Format(Cells(j, 5), "yyyy/mm/dd") <= AsOfWeek Then ' ... End If Next j End Sub

Cám ơn anh nhiều nha, e đã xử lý được rồi nè.

batman1 · 6/10/19

SA_DQ đã viết:

PHP:

Private Sub UserForm_Activate()
Me.Caption = "KE HOACH CONG VIEC DEN NGAY " & Format(Now(), "dd/mm/yyyy")
Sheets("Weekend Plan").Select
Dim AsOFDate, AsOfWeek As String, MaxARRow, MaxARColumn, ListQuaHanRow, ListDenHanRow As Integer
AsOFDate = Format(Now(), "mm/DD/yyyy")      'AsOFDate = Format(Now(), "dd/mm/yyyy") '
AsOfWeek = Format(Now() + 7, "mm/DD/yyyy")  'AsOfWeek = Format(Now() + 7, "dd/mm/yyyy") '
MaxARRow = Range("MaxARRow")
MaxARColumn = Range("MaxARColumn")
ListQuaHanRow = 0:                              ListDenHanRow = 0
Me.ListQuaHan.Clear:                            Me.ListDenHan.Clear
'Loc Phát Sinh Quá Han  '
Me.MultiPage1.Value = 0
For i = 2 To MaxARRow
    If Format(Cells(i, 5), "mm/DD/yyyy") < AsOFDate Then
        Me.ListQuaHan.AddItem (Cells(i, 1))
        Me.ListQuaHan.List(ListQuaHanRow, 1) = Cells(i, 2)
        Me.ListQuaHan.List(ListQuaHanRow, 2) = Cells(i, 3)
        Me.ListQuaHan.List(ListQuaHanRow, 3) = Format(Cells(i, 4), "#,###,###")
        Me.ListQuaHan.List(ListQuaHanRow, 4) = Cells(i, 5)
        Me.ListQuaHan.List(ListQuaHanRow, 5) = Cells(i, 6)
        ListQuaHanRow = ListQuaHanRow + 1
    End If
Next i
'Loc Phát Sinh Dén Han: '
Me.MultiPage1.Value = 1
For j = 2 To MaxARRow
    If Format(Cells(j, 5), "mm/DD/yyyy") >= AsOFDate And Format(Cells(j, 5), "mm/DD/yyyy") <= AsOfWeek Then '** '
        Me.ListDenHan.AddItem (Cells(j, 1))
        Me.ListDenHan.List(ListDenHanRow, 1) = Cells(j, 2)
        Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
        Me.ListDenHan.List(ListDenHanRow, 3) = Format(Cells(j, 4), "#,###,###")
        Me.ListDenHan.List(ListDenHanRow, 4) = Cells(j, 5)
        Me.ListDenHan.List(ListDenHanRow, 5) = Cells(j, 6)
        ListDenHanRow = ListDenHanRow + 1
    End If
Next j
End Sub

Code chắc chắn sai.
Với code như thế thì AsOFDate = "10/06/2019"
Nếu vd. Cells(i, 5) = 6 tháng 1 năm 2020 thì Format(Cells(i, 5), "mm/DD/yyyy") = "01/06/2020
Lúc này thì
Format(Cells(i, 5), "mm/DD/yyyy") = "01/06/2020 < "10/06/2019" = AsOFDate

Tức dữ liệu cho Cells(i, 5) được thêm vào ListBox. Nhưng rõ ràng là ngày "6 tháng 1 năm 2020" là trong tương lai nên chưa hoàn thành vậy không thể thêm vào ListBox.

Nếu đã so sánh chuỗi thì phải tạo nó theo dạng "năm/tháng/ngày"

Bài đã được tự động gộp: 6/10/19

phatgtvt đã viết:
Được rồi nè. e cám ơn anh nhiều nha.

Chắc chắn chứ? Bạn thử thay E2 = "ngày 6 tháng 1 năm 2020" xem. Lúc đó dòng 2 được nhập vào ListBox trong khi ngày E2 là trong tương lai.

phatgtvt · 6/10/19

batman1 đã viết:
Code chắc chắn sai.
Với code như thế thì AsOFDate = "10/06/2019"
Nếu vd. Cells(i, 5) = 6 tháng 1 năm 2020 thì Format(Cells(i, 5), "mm/DD/yyyy") = "01/06/2020
Lúc này thì
Format(Cells(i, 5), "mm/DD/yyyy") = "01/06/2020 < "10/06/2019" = AsOFDate

Tức dữ liệu cho Cells(i, 5) được thêm vào ListBox. Nhưng rõ ràng là ngày "6 tháng 1 năm 2020" là trong tương lai nên chưa hoàn thành vậy không thể thêm vào ListBox.

Nếu đã so sánh chuỗi thì phải tạo nó theo dạng "năm/tháng/ngày"

Bài đã được tự động gộp: 6/10/19

Chắc chắn chứ? Bạn thử thay E2 = "ngày 6 tháng 1 năm 2020" xem. Lúc đó dòng 2 được nhập vào ListBox trong khi ngày E2 là trong tương lai.

Vâng, được rồi a. Giờ chỉ vướng chỗ như comment trong hình nữa a (trong excel hiện còn 1 ngày, trong bảng hiện ra chỉ số 1), a có cách nào ko a.

batman1 · 6/10/19

phatgtvt đã viết:
Vâng, được rồi a.

Có nghĩa là tôi sai? Tức bạn vẫn cho là code của bạn SA_DQ đúng?
Lúc trước là "Được rồi nè", bây giờ là "Vâng, được rồi a". Tức bạn vẫn cho là không có gì sai cả? Viết thì nên viết rõ, tránh để hiểu lầm.

Giờ chỉ vướng chỗ như comment trong hình nữa a, a có cách nào ko a.

Sai đúng đều như nhau cả thì mất công làm để mà làm gì.

phatgtvt · 6/10/19

batman1 đã viết:
Có nghĩa là tôi sai? Tức bạn vẫn cho là code của bạn SA_DQ đúng?
Lúc trước là "Được rồi nè", bây giờ là "Vâng, được rồi a". Tức bạn vẫn cho là không có gì sai cả? Viết thì nên viết rõ, tránh để hiểu lầm.

Sai đúng đều như nhau cả thì mất công làm để mà làm gì.

Ý em là sau khi tiếp nhận và chỉnh sửa theo ý của a, code đã hoạt động theo đúng nội dung e muốn hiển thị. cám ơn a nhiều.

truongvu317 · 6/10/19

batman1 đã viết:
Nếu thế thì dùng dạng "yyy/mm/dd"

Nếu để ở dạng chuỗi phải so sánh năm, sau đó mới đến tháng và cuối cùng là ngày bác nhỉ, cần thiết thì bỏ luốn dấu phân cách ngày tháng cho nó nhanh.

batman1 · 6/10/19

truongvu317 đã viết:
Nếu để ở dạng chuỗi phải so sánh năm, sau đó mới đến tháng và cuối cùng là ngày bác nhỉ,

Đúng rồi.

cần thiết thì bỏ luốn dấu phân cách ngày tháng cho nó nhanh.

Đúng rồi. Viết theo "người ta" mà không chịu suy nghĩ.

AnhThu-1976 · 11/10/19

Tại sao khi mở file (file đã lưu vào thư mục) thì có file hỏi "Enable Macro", có file thì không hỏi?
Em đang sử dụng Win 7 và Office 2010
Em cũng đã vào Trust Center để kiểm tra nhưng không thấy sự khác biệt
Nhờ anh/chị giải thích. Em cảm ơn.

bobokiki132 · 11/10/19

Nhờ các a/c sửa giúp e đoạn code này với ạ. Vấn đề chính là khi e ấn nút SAVE thì nó chỉ lưu có câu lệnh đầu tiên.

VuVanHao · 11/10/19

Anh chị xem giúp nếu muốn thay cột A trong sheet nhập thành cột C thì chỉnh code như thế nào ạ
Em cảm ơn!

SA_DQ · 11/10/19

Anh chị xem giúp nếu muốn thay cột A trong sheet nhập thành cột C thì chỉnh code như thế nào ạ

Vậy xin hỏi bạn macro nào cần chỉnh vậy bạn?

batman1 · 12/10/19

bobokiki132 đã viết:
Nhờ các a/c sửa giúp e đoạn code này với ạ. Vấn đề chính là khi e ấn nút SAVE thì nó chỉ lưu có câu lệnh đầu tiên.View attachment 226500 View attachment 226499

Lý thuyết:
Nếu ListBox có nguồn được định nghĩa ListBox.RowSource là ... thì:
1. Nếu click vào một mục bất kỳ trong ListBox hoặc thay đổi ListBox.ListIndex bằng code thì:
- trước hết code của ListBox_Change được thực hiện nếu có.
- tiếp theo code của ListBox_Click được thực hiện nếu có.

2. Khi vùng RowSource trên sheet (là nguồn của ListBox) thay đổi thì ListBox được làm mới.
Khi ListBox được làm mới thì:
- nếu hiện hành không có mục nào được chọn (ListIndex = -1) thì không có code nào được thực hiện thêm.
- nếu hiện hành có mục nào đó được chọn (ListIndex > -1) thì của ListBox_Change được thực hiện nếu có, tiếp theo code của ListBox_Click được thực hiện nếu có.
-----
Trước hết xét code

Mã:

Private Sub lb_dulieu_Click()
    With Me
        If .lb_dulieu.ListIndex >= 0 Then _
            .txt_sanpham_2.Value = .lb_dulieu.List(lb_dulieu.ListIndex, 1)
            ....
            .txt_sotien_2.Value = .lb_dulieu.List(lb_dulieu.ListIndex, 16)
        End With
End Sub

Theo lôgíc thì tất cả các dòng chứ không chỉ dòng đầu tiên đều phải nằm trong IF ... END IF.

Tức bỏ ký tự "_" sau Then và thêm "End If" trước "End With"
------
Vùng dữ liệu nguồn cho lb_dulieu được bạn thiết lập là data_sp (lb_dulieu.RowSource = data_sp).

Ta xét một ví dụ cụ thể để có thể giải thích cụ thể. Giả sử bạn chọn trong lb_dulieu dòng có STT = 4, ứng với dòng 6 trên sheet SP. Code của lb_dulieu_Click sẽ được thực hiện, hậu quả là các giá trị của dòng được chọn sẽ được nhập vào các textbox trên Form. Bây giờ giả sử bạn chỉnh sửa các giá trị trong các textbox bằng cách thêm hậu tố " mới". Tiếp theo bạn nhấn nút SAVE thì code của btnchange_Click sẽ được thực hiện

Mã:

Private Sub btnchange_Click()
Dim dong_sua As Long
    dong_sua = Sheets("SP").Range("A" & lb_dulieu.ListIndex + 2).Row
        With Worksheets("SP")
            .Cells(dong_sua, 2).Value = Dulieu_SP.txt_sanpham_2
            .Cells(dong_sua, 3).Value = Dulieu_SP.combo_ma_KH_2
            .Cells(dong_sua, 4).Value = Dulieu_SP.combo_nhucau_2
            .Cells(dong_sua, 5).Value = Dulieu_SP.combo_mucdogap_2
            .Cells(dong_sua, 6).Value = txt_add_2
            .Cells(dong_sua, 7).Value = txt_duan_2
            .Cells(dong_sua, 8).Value = txt_solo_2
            .Cells(dong_sua, 9).Value = txt_sothua_2
            .Cells(dong_sua, 10).Value = txt_soto_2
            .Cells(dong_sua, 11).Value = txt_dientich_2
            .Cells(dong_sua, 12).Value = txt_loaidat_2
            .Cells(dong_sua, 13).Value = txt_huong_2
            .Cells(dong_sua, 14).Value = txt_kichthuoc_2
            .Cells(dong_sua, 15).Value = txt_congtrinh_2
            .Cells(dong_sua, 16).Value = combo_cachtinh_2
            .Cells(dong_sua, 17).Value = txt_sotien_2
            .Cells(dong_sua, 18).Value = .Cells(dong_sua, 18).Value & "Edit by:" & Sheets("menu").Range("F2").Text & "; Edit Time: " & Now()
          End With
End Sub

Sau khi thực hiện dòng đầu tiên

Mã:

.Cells(dong_sua, 2).Value = Dulieu_SP.txt_sanpham_2

Thì trên sheet ô B6 sẽ có giá trị B6 = "THU.NT-4 mới".
Do dữ liệu trong vùng dữ liệu nguồn data_sp thay đổi (B6) nên theo lý thuyết thì code của lb_dulieu_Click sẽ được thực hiện. Đó chính là code ở trên. Bạn nhìn kỹ thì sẽ thấy là giá trị của các textbox mà bạn vừa bỏ nhiều công sức để thêm " mới" đã bị thay thế bằng các giá trị của lb_dulieu, tức lấy từ nguồn data_sp trên sheet do lb_dulieu được làm mới khi data_sp thay đổi Mà trên sheet mới chỉ có B6 thay đổi thôi, còn các giá trị khác chưa có " mới". Tức sau khi thực hiện lb_dulieu_Click thì chỉ có txt_sanpham_2 là có hậu tố " mới" do lấy từ cột 2 hàng 5 (ứng với B6 trên sheet) của lb_dulieu. Các textbox khác không có hậu tố " mới". Chúng có các giá trị y như sau khi chọn dòng STT = 4 và trước khi chỉnh sửa. Vì thế khi code thực thi các dòng còn lại bắt đầu từ dòng

Mã:

.Cells(dong_sua, 3).Value = Dulieu_SP.combo_ma_KH_2

tới cuối thì do các textbox không chứa các hậu tố " mới" mà chỉ chứa các giá trị y như trên sheet nên hiển nhiên là các giá trị trên sheet được thay bằng chính chúng nên không thể có hậu tố " mới" được.

Nếu có nhu cầu chỉnh sửa trên sheet thì không được phép chỉnh sửa trong vùng RowSource của ListBox. Nếu cần chỉnh sửa trong một vùng mà vùng đó đồng thời là dữ liệu nguồn cho ListBox thì phải cẩn thận khi dùng ListBox_Change và ListBox_Click. Nếu trong ListBox_Click code thay đổi giá trị của các textbox như của bạn, tức chúng được thay đổi - lấy từ vùng nguồn của ListBox, thì công lao chỉnh sửa các textbox trước đó đổ xuống sông xuống biển. Tôi hiểu là code Click phải thế để lấy các giá trị của dòng được chọn trong ListBox vào các textbox. Vậy thì phải từ bỏ dùng RowSource và dùng List để nhập dữ liệu vào ListBox.

Tóm lại:
0. Thêm End If vào lb_dulieu_Click
1. Xóa lb_dulieu.RowSource.
2. Thêm code vào Form

Mã:

Private Sub UserForm_Initialize()
    lb_dulieu.List = Worksheets("SP").Range("data_sp").Value
End Sub

3. Đễ làm mới lb_dulieu sau khi ghi xuống sheet thì trong Sub btnchange_Click sau dòng End With thì thêm code

Mã:

lb_dulieu.List = Worksheets("SP").Range("data_sp").Value

bobokiki132 · 12/10/19

batman1 đã viết:
Lý thuyết:
Nếu ListBox có nguồn được định nghĩa ListBox.RowSource là ... thì:
1. Nếu click vào một mục bất kỳ trong ListBox hoặc thay đổi ListBox.ListIndex bằng code thì:
- trước hết code của ListBox_Change được thực hiện nếu có.
- tiếp theo code của ListBox_Click được thực hiện nếu có.

2. Khi vùng RowSource trên sheet (là nguồn của ListBox) thay đổi thì ListBox được làm mới.
Khi ListBox được làm mới thì:
- nếu hiện hành không có mục nào được chọn (ListIndex = -1) thì không có code nào được thực hiện thêm.
- nếu hiện hành có mục nào đó được chọn (ListIndex > -1) thì của ListBox_Change được thực hiện nếu có, tiếp theo code của ListBox_Click được thực hiện nếu có.
-----
Trước hết xét code

Mã:

Private Sub lb_dulieu_Click() With Me If .lb_dulieu.ListIndex >= 0 Then _ .txt_sanpham_2.Value = .lb_dulieu.List(lb_dulieu.ListIndex, 1) .... .txt_sotien_2.Value = .lb_dulieu.List(lb_dulieu.ListIndex, 16) End With End Sub

Theo lôgíc thì tất cả các dòng chứ không chỉ dòng đầu tiên đều phải nằm trong IF ... END IF.

Tức bỏ ký tự "_" sau Then và thêm "End If" trước "End With"
------
Vùng dữ liệu nguồn cho lb_dulieu được bạn thiết lập là data_sp (lb_dulieu.RowSource = data_sp).

Ta xét một ví dụ cụ thể để có thể giải thích cụ thể. Giả sử bạn chọn trong lb_dulieu dòng có STT = 4, ứng với dòng 6 trên sheet SP. Code của lb_dulieu_Click sẽ được thực hiện, hậu quả là các giá trị của dòng được chọn sẽ được nhập vào các textbox trên Form. Bây giờ giả sử bạn chỉnh sửa các giá trị trong các textbox bằng cách thêm hậu tố " mới". Tiếp theo bạn nhấn nút SAVE thì code của btnchange_Click sẽ được thực hiện

Mã:

Private Sub btnchange_Click() Dim dong_sua As Long dong_sua = Sheets("SP").Range("A" & lb_dulieu.ListIndex + 2).Row With Worksheets("SP") .Cells(dong_sua, 2).Value = Dulieu_SP.txt_sanpham_2 .Cells(dong_sua, 3).Value = Dulieu_SP.combo_ma_KH_2 .Cells(dong_sua, 4).Value = Dulieu_SP.combo_nhucau_2 .Cells(dong_sua, 5).Value = Dulieu_SP.combo_mucdogap_2 .Cells(dong_sua, 6).Value = txt_add_2 .Cells(dong_sua, 7).Value = txt_duan_2 .Cells(dong_sua, 8).Value = txt_solo_2 .Cells(dong_sua, 9).Value = txt_sothua_2 .Cells(dong_sua, 10).Value = txt_soto_2 .Cells(dong_sua, 11).Value = txt_dientich_2 .Cells(dong_sua, 12).Value = txt_loaidat_2 .Cells(dong_sua, 13).Value = txt_huong_2 .Cells(dong_sua, 14).Value = txt_kichthuoc_2 .Cells(dong_sua, 15).Value = txt_congtrinh_2 .Cells(dong_sua, 16).Value = combo_cachtinh_2 .Cells(dong_sua, 17).Value = txt_sotien_2 .Cells(dong_sua, 18).Value = .Cells(dong_sua, 18).Value & "Edit by:" & Sheets("menu").Range("F2").Text & "; Edit Time: " & Now() End With End Sub

Sau khi thực hiện dòng đầu tiên

Mã:

.Cells(dong_sua, 2).Value = Dulieu_SP.txt_sanpham_2

Thì trên sheet ô B6 sẽ có giá trị B6 = "THU.NT-4 mới".
Do dữ liệu trong vùng dữ liệu nguồn data_sp thay đổi (B6) nên theo lý thuyết thì code của lb_dulieu_Click sẽ được thực hiện. Đó chính là code ở trên. Bạn nhìn kỹ thì sẽ thấy là giá trị của các textbox mà bạn vừa bỏ nhiều công sức để thêm " mới" đã bị thay thế bằng các giá trị của lb_dulieu, tức lấy từ nguồn data_sp trên sheet do lb_dulieu được làm mới khi data_sp thay đổi Mà trên sheet mới chỉ có B6 thay đổi thôi, còn các giá trị khác chưa có " mới". Tức sau khi thực hiện lb_dulieu_Click thì chỉ có txt_sanpham_2 là có hậu tố " mới" do lấy từ cột 2 hàng 5 (ứng với B6 trên sheet) của lb_dulieu. Các textbox khác không có hậu tố " mới". Chúng có các giá trị y như sau khi chọn dòng STT = 4 và trước khi chỉnh sửa. Vì thế khi code thực thi các dòng còn lại bắt đầu từ dòng

Mã:

.Cells(dong_sua, 3).Value = Dulieu_SP.combo_ma_KH_2

tới cuối thì do các textbox không chứa các hậu tố " mới" mà chỉ chứa các giá trị y như trên sheet nên hiển nhiên là các giá trị trên sheet được thay bằng chính chúng nên không thể có hậu tố " mới" được.

Nếu có nhu cầu chỉnh sửa trên sheet thì không được phép chỉnh sửa trong vùng RowSource của ListBox. Nếu cần chỉnh sửa trong một vùng mà vùng đó đồng thời là dữ liệu nguồn cho ListBox thì phải cẩn thận khi dùng ListBox_Change và ListBox_Click. Nếu trong ListBox_Click code thay đổi giá trị của các textbox như của bạn, tức chúng được thay đổi - lấy từ vùng nguồn của ListBox, thì công lao chỉnh sửa các textbox trước đó đổ xuống sông xuống biển. Tôi hiểu là code Click phải thế để lấy các giá trị của dòng được chọn trong ListBox vào các textbox. Vậy thì phải từ bỏ dùng RowSource và dùng List để nhập dữ liệu vào ListBox.

Tóm lại:
0. Thêm End If vào lb_dulieu_Click
1. Xóa lb_dulieu.RowSource.
2. Thêm code vào Form

Mã:

Private Sub UserForm_Initialize() lb_dulieu.List = Worksheets("SP").Range("data_sp").Value End Sub

3. Đễ làm mới lb_dulieu sau khi ghi xuống sheet thì trong Sub btnchange_Click sau dòng End With thì thêm code

Mã:

lb_dulieu.List = Worksheets("SP").Range("data_sp").Value

Cảm ơn a Batman1 rất nhiều. đúng cái e cần luôn. Vấn đề chính của e là dùng RowSource nên sửa được 1 ô là nó cập nhật lại luôn.

VuVanHao · 12/10/19

SA_DQ đã viết:
Vậy xin hỏi bạn macro nào cần chỉnh vậy bạn?

Em được anh Batman1 chỉ giúp rồi ạ,
Em cảm ơn ạ

batman1 · 12/10/19

bobokiki132 đã viết:
Cảm ơn a Batman1 rất nhiều. đúng cái e cần luôn. Vấn đề chính của e là dùng RowSource nên sửa được 1 ô là nó cập nhật lại luôn.

Nếu vẫn muốn dùng RowSource thì phải thay lb_dulieu_Click bằng lb_dulieu_DblClick. Lúc đó trong quá trình ghi xuống sheet thì ListBox vẫn được làm mới liên tục nhưng do DblClick không được gọi (chỉ cọ Click được gọi) nên các textbox không bị chuyển về các giá trị cũ lấy từ ListBox (lấy từ sheet).
Nhưng tôi không thích cái đỏ đỏ. Dùng List và khi nào cần làm mới ListBox thì mới gọi code làm mới thôi.

phatgtvt · 18/10/19

Các anh/ chị cho e hỏi, có cách nào chỉnh được như comment trong hình ko vậy anh/chị?
Em mới tập tành VBA nên cũng ko rõ lắm. Cám ơn anh/chị trước nhé.

bobokiki132 · 19/10/19

phatgtvt đã viết:
Các anh/ chị cho e hỏi, có cách nào chỉnh được như comment trong hình ko vậy anh/chị?
Em mới tập tành VBA nên cũng ko rõ lắm. Cám ơn anh/chị trước nhé.

View attachment 226867

Mình nghĩ ra 2 cách bạn xem dùng được thì dùng:
Cách 1: Thay đổi công thức ở cột C thành: =+IF(-TODAY()+E2<0;"Hoàn thành";IF(-TODAY()+E2=0;"Đến hạn";"Còn "&E2-TODAY()&" ngày"));
Cách 2: thay đoạn code:
'Loc Phát Sinh Dén Han: '
...
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
....
Thành code:
If Cells(j, 3) = ChrW(272) & ChrW(7871) & "n h" & ChrW(7841) & "n" Then
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
Else: Me.ListDenHan.List(ListDenHanRow, 2) = "Còn " & Cells(j, 3) & "ngày"
End If

Bổ sung cách 3 ngắn và đơn giản nhất:
thay code:
'Loc Phát Sinh Dén Han: '
...
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
....
Thành code:
'Loc Phát Sinh Dén Han: '
...
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3).text
....

phatgtvt · 20/10/19

bobokiki132 đã viết:
Mình nghĩ ra 2 cách bạn xem dùng được thì dùng:
Cách 1: Thay đổi công thức ở cột C thành: =+IF(-TODAY()+E2<0;"Hoàn thành";IF(-TODAY()+E2=0;"Đến hạn";"Còn "&E2-TODAY()&" ngày"));
Cách 2: thay đoạn code:
'Loc Phát Sinh Dén Han: '
...
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
....
Thành code:
If Cells(j, 3) = ChrW(272) & ChrW(7871) & "n h" & ChrW(7841) & "n" Then
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
Else: Me.ListDenHan.List(ListDenHanRow, 2) = "Còn " & Cells(j, 3) & "ngày"
End If

Bổ sung cách 3 ngắn và đơn giản nhất:
thay code:
'Loc Phát Sinh Dén Han: '
...
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3)
....
Thành code:
'Loc Phát Sinh Dén Han: '
...
Me.ListDenHan.List(ListDenHanRow, 2) = Cells(j, 3).text
....

Em đã làm được, cám ơn bobokiki132 nhiều nha.

hoanganhle2k · 23/10/19

Em chào các anh chị ạ,
Em đang là học sinh cấp 2, và đang tìm tòi học VBA ạ,

Em đang chưa biết làm 1 bài toán như này, mong a chị gợi ý thuật toán giúp em ạ:

Gán vào 1 cell trong sheet, 1 giá trị (bằng số) - (ví dụ gán vào cell (1,1) giá trị bằng 10), cứ sau 2' thì giá trị trong cell (1,1) cộng thêm 1

-----------
Em đã tìm google mấy ngày nay cả web tiếng việt và tiếng anh nhưng ko ra cách làm ạ (e ko giỏi tiếng anh cho lắm ^^), mong anh chị chỉ giáo ạ

Em cám ơn nhiều ạ !

VetMini · 23/10/19

Mới tìm tòi học mà vọc chi cái rắc rối vậy? Cái này rất ít liên quan đến thuật toán lập trình, nó chỉ là một xảo thuật.

Từ khoá để tìm: Appplication.OnTime (tìm ở GPE cũng được, có cả đống)

Chú: nếu còn muốn hỏi tiếp thì nên học thói quen viết trọn từ, tránh viết tắt. Chịu khó để ý sẽ thấy những người trả lời rất hiếm khi viết tắt.

snow25 · 23/10/19

hoanganhle2k đã viết:
Em chào các anh chị ạ,
Em đang là học sinh cấp 2, và đang tìm tòi học VBA ạ,

Em đang chưa biết làm 1 bài toán như này, mong a chị gợi ý thuật toán giúp em ạ:

Gán vào 1 cell trong sheet, 1 giá trị (bằng số) - (ví dụ gán vào cell (1,1) giá trị bằng 10), cứ sau 2' thì giá trị trong cell (1,1) cộng thêm 1

-----------
Em đã tìm google mấy ngày nay cả web tiếng việt và tiếng anh nhưng ko ra cách làm ạ (e ko giỏi tiếng anh cho lắm ^^), mong anh chị chỉ giáo ạ

Em cám ơn nhiều ạ !

Thử chơi.À mà nó không dừng đâu nhé.

iamnobika · 25/10/19

Các thầy/anh ơi, mình có thể tạo ra Function mà có thể gọi tên sheet, hoặc tạo ra 1 mảng tên các sheet được ko ạ?

snow25 · 25/10/19

iamnobika đã viết:
Các thầy/anh ơi, mình có thể tạo ra Function mà có thể gọi tên sheet, hoặc tạo ra 1 mảng tên các sheet được ko ạ?

Bạn thử.

Mã:

Function tensheet(ByVal so As Integer) As String
        tensheet = Sheets(so).Name
End Function

Mã:

=tensheet(1)

iamnobika · 25/10/19

snow25 đã viết:
Bạn thử.

Mã:

Function tensheet(ByVal so As Integer) As String tensheet = Sheets(so).Name End Function

Mã:

=tensheet(1)

em cám ơn anh, nhưng sao em kết hợp =tensheet(row(1:4)) không tạo ra được mảng tên sheet anh ạ

snow25 · 25/10/19

iamnobika đã viết:
em cám ơn anh, nhưng sao em kết hợp =tensheet(row(1:4)) không tạo ra được mảng tên sheet anh ạ

Bạn kéo nó dài ra nhé.Cái này nó chỉ hiện tên 1 sheets thôi mà.

iamnobika · 25/10/19

snow25 đã viết:
Bạn kéo nó dài ra nhé.Cái này nó chỉ hiện tên 1 sheets thôi mà.

em muốn kết hợp công thức mảng vào cái hàm tensheet đó anh để tạo ra mảng {TH, ab, cd, xy} sau đó sẽ dùng tiếp hàm indirect để giải quyết theo mục đích
Cơ mà =tensheet{1,2,3,4} nó báo lỗi value
Có phải function tạo ra không thể tạo mảng nhưng trong công thức excel phải ko ạ?

snow25 · 25/10/19

iamnobika đã viết:
em muốn kết hợp công thức mảng vào cái hàm tensheet đó anh để tạo ra mảng {TH, ab, cd, xy} sau đó sẽ dùng tiếp hàm indirect để giải quyết theo mục đích
Cơ mà =tensheet{1,2,3,4} nó báo lỗi value
Có phải function tạo ra không thể tạo mảng nhưng trong công thức excel phải ko ạ?

Bạn thử cái hàm mảng này.

iamnobika · 25/10/19

snow25 đã viết:
Bạn thử cái hàm mảng này.

em cảm ơn anh ạ !

haog · 25/10/19

thanhduc1986 đã viết:
Kính nhờ các anh chị chỉ giúp mình 1 đoạn code về tìm ngày trong dữ liệu.
Giả sử cột A chứa dữ liệu dạng Date, format dd/mm/yyyy, sắp xếp tăng dần (các giá trị có thể không liên tục, có thể có nhiều dòng có cùng giá trị).

Có thể dùng code Function sau
Function TimDong(arr As Range, gt As Date) As Integer
Dim k As Range
For Each k In arr
If k.Value >= gt Then
TimDong = k.Row
Exit Function
End If
Next
End Function

Không cần bẫy lỗi vì nếu không có thì cho KQ = 0.

bazooka.92 · 26/10/19

chào các anh. các anh cho em hỏi cái nyaf là em bị lồi gì ạ

Private Sub Textcaphanmem_Change()
On Error Resume Next
Textcaphanmem.Text = Format(Textcaphanmem.Text, "#,##0")
End Sub

em dùng hàm này trong userfrom mà trong textbox thì hiện đúng nhưng trong file nhập excel thì bị thiều mất 3 số 0
VD như trong textbox nhập 2000000 textbox sẽ hiện 2,000,000 trong execl là 2.000.000
nhưng khi nhập 200000 texbox hiện 200,000 exel chỉ hiện 200
em đã chỉnh lại trong Format cells/Number/Custome #,##0 đung như trong textbox rồi

lantn90 · 28/10/19

Help Me!!!
Kính gửi các anh chị trên diễn đàn mình, em mới học VBA nên chưa biết sửa code đúng cách, rất mong các anh chị chỉ giáo giúp em.
chẳng là e muốn lấy danh sách những ông bà (gồm tất cả các cột như trong file data1) mà có giá trị tại cột PENINT và/hoăc cột BILINT và/hoặc cột BILPRN #0 sang báo cáo tại file final. Tức là nếu giá trị tại 3 cột trền đều bằng 0 thì e ko lấy.
E đã viết code, nhưng mắc lỗi và không biết sửa.
P/s: Các anh/chị có thể thay đổi đương dẫn trong code để mở file data1 ạ.
Mong các anh chị xem sớm giúp e với, em cảm ơn rất rất nhiều ạ.

huongmuine · 8/11/19

Mã:

Sub Test()
With Sheets("KH")
If .Range("D48") <> Empty Then
     .Range("AQ47") = "."
If .Range("D54") <> Empty Then
     .Range("AQ53") = "."
If .Range("D60") <> Empty Then
     .Range("AQ59") = "."
If .Range("D66") <> Empty Then
     .Range("AQ65") = "."
End If
End If
End If
End If
End With
End Sub

Đoạn code trên có thể viết gọn lại nữa không ạ. Nếu được, nhờ các anh chị chỉ giúp.
Xin cảm ơn

snow25 · 8/11/19

huongmuine đã viết:
Mã:

Sub Test() With Sheets("KH") If .Range("D48") <> Empty Then .Range("AQ47") = "." If .Range("D54") <> Empty Then .Range("AQ53") = "." If .Range("D60") <> Empty Then .Range("AQ59") = "." If .Range("D66") <> Empty Then .Range("AQ65") = "." End If End If End If End If End With End Sub

Đoạn code trên có thể viết gọn lại nữa không ạ. Nếu được, nhờ các anh chị chỉ giúp.
Xin cảm ơn

Bạn hiểu đoạn code trên không.Đó là 4 hàm if lồng nhau.Cái điều kiện cuối cùng thì cần phải đúng 4 cái thì mới được thực hiện.Nên không thể rút gọn được.

leonguyenz · 8/11/19

huongmuine đã viết:
Mã:

Sub Test() With Sheets("KH") If .Range("D48") <> Empty Then .Range("AQ47") = "." If .Range("D54") <> Empty Then .Range("AQ53") = "." If .Range("D60") <> Empty Then .Range("AQ59") = "." If .Range("D66") <> Empty Then .Range("AQ65") = "." End If End If End If End If End With End Sub

Đoạn code trên có thể viết gọn lại nữa không ạ. Nếu được, nhờ các anh chị chỉ giúp.
Xin cảm ơn

Nếu D48 = Empty và D54 <> Empty thì AQ53 có bằng "." không? Nếu AQ53 = "." thì tôi nghĩ code trên còn thiếu.

HieuCD · 8/11/19

snow25 đã viết:
Bạn hiểu đoạn code trên không.Đó là 4 hàm if lồng nhau.Cái điều kiện cuối cùng thì cần phải đúng 4 cái thì mới được thực hiện.Nên không thể rút gọn được.

Dùng
For ...
if ....
....
else
exit for
end if
next

hungyen2010 · 8/11/19

hi cả nhả e đang làm thông báo điểm với bảng điểm từ file excel sang file thông báo là file word nhưng vị trí bảng điểm hiện thị trong file word không đúng vị trí mà luôn hiện ở cuối trang word mong các bác giúp em.Em cảm ơn

tonnydung · 25/11/19

Em nhờ các bác giúp 4 trường hợp sau giúp:

1/ Code VBA để coppy sau VD: Sheet 1
Khi ta dang Mở File A ở Sheet 1 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet1 File C những cột A,B,C,D Nếu thỏa cột B có chữ "nhà xe" vào Sheet1 File A

2/ Code VBA để coppy sau VD: Sheet 2
Khi ta dang Mở Sheet2 File A ở Sheet 2 có 1 nút "coppy" Khi click vào Nút "Coppy" thì Coppy tất cả các hàng trong Sheet2 File C những cột A,B,C,D,E,F,G,H,I,K Nếu thỏa cột C Không có chữ "HQ" vào Sheet2 File A

3/ Code VBA để coppy sau VD: Sheet 3
Khi dang lam viec o Sheet3 FileA có các hàng dữ liệu liền nhau có các cột A,B,C,D,E và trong sheet đó có nút Coppy. Nếu Click vào nút Coppy mà thỏa mãn 2 điều kiện sau:
- Dieu kien 1: cột A trong Sheet3 FileC và cột A Sheet3 FileA (sheet và file hiện thời làm việc) có số số liệu trùng nhau.
- Dieu kien 2: cột F trong Sheet3 FileC không có dấu "x"
thì sẽ coppy các dữ liệu của các hàng ở Cột C,D,E của Sheet3 FileC sang các cột C,D,E của Sheet3 FileA
(lưu ý giúp: dữ liệu hãng ở Sheet3 FileA có thể ko liền nhau)

4/ Code VBA trong Form VD: Sheet 4
Trong 1 Form có 2 text boxt sau:
Text boxt 1, Text boxt 2
Khi nhập dữ liệu vào Text boxt 1 bấm enter thì Text boxt 2 ktra 3 ký tự đầu của
Text boxt 1 nếu có 3 chữ "kle" thì Text boxt 2 sẽ tự điền là "kh" còn ko có Text boxt 2 sẽ điền "nhà xe"

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

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

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

Đang đi tìm hòn đá

Thành viên gạo cội

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

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

File đính kèm

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

Thành viên gạo cội

GPE - My love

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

GPE - My love

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

GPE - My love

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

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

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

Thành viên gạo cội

Thành viên gạo cội

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

Thành viên gạo cội

Giải pháp Ếc-xào

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

File đính kèm

/(hông là gì!

Thành viên mới

Thành viên gạo cội

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

Đang đi tìm hòn đá

Thành viên gạo cội

Thành viên mới

File đính kèm

GPE - My love

File đính kèm

Thành viên mới

Thành viên mới

Đang đi tìm hòn đá

Thành viên mới

File đính kèm

GPE - My love

Thành viên mới

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

File đính kèm

Thành viên mới

File đính kèm

Đang đi tìm hòn đá

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên gạo cội

Thành viên mới

GPE - My love

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

Thành viên mới

Đang đi tìm hòn đá

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

GPE - My love

Thành viên gạo cội

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

File đính kèm

whom?

GPE - My love

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

whom?

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

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

GPE - My love

Thành viên mới

File đính kèm

Đang đi tìm hòn đá

/(hông là gì!

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội