Chuyên đề giải đáp những thắc mắc về code VBA (3 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]

tam888 · 23/11/18

tonnydung đã viết:
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à.

Dùng cách dò tìm, trong VBA thì Range.Find.... tức là dùng method Find của Range

noinhodayvoi20_10 · 27/11/18

Chào mọi người, mọi người giúp e code VBA với điều kiện
nếu trong vùng dữ liệu có 1 ô nào có gtri bằng 0 thì xóa luôn dòng đó với ạ.
e cám ơn nhiều.

♫ђöล♥ßล†♥†µ♫ · 27/11/18

noinhodayvoi20_10 đã viết:
Chào mọi người, mọi người giúp e code VBA với điều kiện
nếu trong vùng dữ liệu có 1 ô nào có gtri bằng 0 thì xóa luôn dòng đó với ạ.
e cám ơn nhiều.

Bạn xem thử

PHP:

Sub Xoadong()
    Dim sArr, I As Long, J As Long, Er As Long
    Dim rng As Range, Dk As Boolean: Dk = False
Er = Range("A" & Rows.Count).End(xlUp).Row
If Er > 1 Then
    sArr = Range("A1:A" & Er).Resize(, 6).Value
    For I = 2 To UBound(sArr)
        For J = 1 To UBound(sArr, 2)
            If sArr(I, J) = Empty Then
                Dk = True
                If rng Is Nothing Then
                    Set rng = Range("A" & I).EntireRow
                Else
                    Set rng = Union(rng, Range("A" & I).EntireRow)
                End If
                Exit For
            End If
        Next J
    Next
    If Dk = True Then
        rng.Select
        'rng.Delete
    Else
        MsgBox "Nothing"
    End If
End If
End Sub

noinhodayvoi20_10 · 27/11/18

♫ђöล♥ßล†♥†µ♫ đã viết:

Bạn xem thử

Mã:

Sub Xoadong()
    Dim sArr, I As Long, J As Long, Er As Long
    Dim rng As Range
Er = Range("A" & Rows.Count).End(xlUp).Row
If Er > 1 Then
    sArr = Range("A1:A" & Er).Resize(, 6).Value
    For I = 2 To UBound(sArr)
        For J = 1 To UBound(sArr, 2)
            If sArr(I, J) = Empty Then
                If rng Is Nothing Then
                    Set rng = Range("A" & I).EntireRow
                Else
                    Set rng = Union(rng, Range("A" & I).EntireRow)
                End If
                Exit For
            End If
        Next J
    Next
    rng.Select
    'rng.Delete
End If
End Sub

cám ơn nhiều ạ
cho hỏi thêm là nếu vùng dữ liệu mở rộng ra thì code này có thực hiện được không ạ.
với mấy cái code union này kia mình tìm hiểu tài liệu ở đâu được.

Ba Tê · 27/11/18

noinhodayvoi20_10 đã viết:
cám ơn nhiều ạ
cho hỏi thêm là nếu vùng dữ liệu mở rộng ra thì code này có thực hiện được không ạ.
với mấy cái code union này kia mình tìm hiểu tài liệu ở đâu được.

Tôi vẫn khoái chơi với mảng.
Trong file bạn thì dữ liệu có 6 cột, nếu dữ liệu <>6 cột thì khai báo lại biến CoL
Đặt tên sheet là "GPE".

PHP:

Public Sub sGpe()
Const CoL As Long = 6                 'Số cột là 6 trong bảng dữ liệu.'
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
With Sheets("GPE")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, CoL).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To CoL)
    For I = 1 To R
        K = K + 1
        For J = 1 To CoL
            dArr(K, J) = sArr(I, J)
            If sArr(I, J) = 0 Then
                K = K - 1
                Exit For
            End If
        Next J
    Next I
    Range("A2").Resize(R, CoL).ClearContents
    If K Then .Range("A2").Resize(K, CoL) = dArr
End With
End Sub

♫ђöล♥ßล†♥†µ♫ · 27/11/18

noinhodayvoi20_10 đã viết:
cám ơn nhiều ạ

với mấy cái code union này kia mình tìm hiểu tài liệu ở đâu được.

Bạn vào nhà Anh @befaint lục tìm nha. Anh ấy không khóa cửa đâu. Chỉ tội đồ hơi nhiều. Tìm hơi lâu 1 tí

noinhodayvoi20_10 · 27/11/18

Ba Tê đã viết:

Tôi vẫn khoái chơi với mảng.
Trong file bạn thì dữ liệu có 6 cột, nếu dữ liệu <>6 cột thì khai báo lại biến CoL
Đặt tên sheet là "GPE".

PHP:

Public Sub sGpe()
Const CoL As Long = 6                 'Số cột là 6 trong bảng dữ liệu.'
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
With Sheets("GPE")
    sArr = .Range("A2", .Range("A2").End(xlDown)).Resize(, CoL).Value
    R = UBound(sArr)
    ReDim dArr(1 To R, 1 To CoL)
    For I = 1 To R
        K = K + 1
        For J = 1 To CoL
            dArr(K, J) = sArr(I, J)
            If sArr(I, J) = 0 Then
                K = K - 1
                Exit For
            End If
        Next J
    Next I
    Range("A2").Resize(R, CoL).ClearContents
    If K Then .Range("A2").Resize(K, CoL) = dArr
End With
End Sub

Kiến thức về mảng thấy phức tạp qá

snow25 · 27/11/18

noinhodayvoi20_10 đã viết:
Kiến thức về mảng thấy phức tạp qá

Theo mình nghĩ mảng nó chỉ là.Không thao tác trên excel mà ghi dữ liệu vào mảng.

noinhodayvoi20_10 · 27/11/18

snow25 đã viết:
Theo mình nghĩ mảng nó chỉ là.Không thao tác trên excel mà ghi dữ liệu vào mảng.

Bthg thì mình xài vòng lặp for cho từng cột.
Nếu bắp gặp ô nào bằng 0 thì xóa luôn dòng đó.
Chỉ có thắc mắc ở chỗ là nếu sử dụng mảng thì liệu Excel nó có chạy nhanh hơn k

SA_DQ · 28/11/18

Chỉ có thắc mắc ở chỗ là nếu sử dụng mảng thì liệu Excel nó có chạy nhanh hơn k

Bạn thử tăng dữ liệu lên vạn dòng & 24 cột & sau đó thử với macro xài mảng dưới đây xem sao:

PHP:

Sub Array_()
Dim Arr()
Dim J As Long, W As Long, Tmr As Double, Cot As Integer, Zero As Boolean

Tmr = Timer():                         Arr() = Sheet2.[B1].CurrentRegion.Offset(1).Value
ReDim dArr(1 To UBound(Arr()), 1 To UBound(Arr(), 2))
For J = 1 To UBound(Arr())
    W = W + 1
    For Cot = 1 To UBound(Arr(), 2)
        If Arr(J, Cot) = 0 Then
            Zero = True:                        W = W - 1
            Exit For
        Else
            dArr(W, Cot) = Arr(J, Cot)
        End If
    Next Cot
Next J
MsgBox J & " => " & W, , Timer() - Tmr
End Sub

Máy cà tèng của mình báo là mất .125" & từ 10242 dòng xuống còn 8640

SA_DQ · 28/11/18

Còn đây là macro để cho thấy sự tăng giảm thời lượng xài 1 hay 2 mảng (Array) với dữ liệu đủ lớn như bài trên:

PHP:

Sub DuyetCotA_CountIf(Num As Integer)
 Dim Rws As Long, J As Long, W As Long, Tmr As Double, Col As Integer, Cot As Integer
 Dim WF As Object

  Tmr = Timer():                            Rws = Sheet1.[B1].CurrentRegion.Rows.Count
  Col = Sheet1.[B1].CurrentRegion.Columns.Count
  Set WF = Application.WorksheetFunction
  ReDim Arr(1 To Rws, 1 To Col)
  For J = 2 To Rws
    If WF.CountIf(Cells(J, "A").Resize(, Col), 0) = 0 Then
        W = W + 1
        If Num = 2 Then
            ReDim dArr(1 To 1, 1 To Col)
            dArr() = Cells(J, 1).Resize(, Col).Value
        End If
        For Cot = 1 To Col
            If Num = 2 Then
                Arr(W, Cot) = dArr(1, Cot)
            ElseIf Num = 1 Then
                Arr(W, Cot) = Cells(J, 1).Offset(, Col - 1).Value
            End If
        Next Cot
    End If
  Next J
  MsgBox J & " => " & W, , Timer() - Tmr
End Sub

noinhodayvoi20_10 · 28/11/18

SA_DQ đã viết:
Bạn thử tăng dữ liệu lên vạn dòng & 24 cột & sau đó thử với macro xài mảng dưới đây xem sao:

PHP:

Sub Array_() Dim Arr() Dim J As Long, W As Long, Tmr As Double, Cot As Integer, Zero As Boolean Tmr = Timer(): Arr() = Sheet2.[B1].CurrentRegion.Offset(1).Value ReDim dArr(1 To UBound(Arr()), 1 To UBound(Arr(), 2)) For J = 1 To UBound(Arr()) W = W + 1 For Cot = 1 To UBound(Arr(), 2) If Arr(J, Cot) = 0 Then Zero = True: W = W - 1 Exit For Else dArr(W, Cot) = Arr(J, Cot) End If Next Cot Next J MsgBox J & " => " & W, , Timer() - Tmr End Sub

Máy cà tèng của mình báo là mất .125" & từ 10242 dòng xuống còn 8640

Dữ liệu của mình trung bình 1 file csv 30Mb
Khoảng 4000 cột, gần 1tr dòng.
Chạy cái máy đơ lun

noinhodayvoi20_10 · 28/11/18

Cho e hỏi trong nhiều sub, phía đầu tiêu đề người ta viết như sau

Mã:

Sub DuyetCotA_CountIf(Num As Integer)

những sub này không chạy trực tiếp được.
vậy những sub này là sao ạ. AC giải thích giùm với.

SA_DQ · 28/11/18

Dữ liệu của mình trung bình 1 file csv 30Mb
Khoảng 4000 cột, gần 1tr dòng.

Máy mình với bộ nhớ hạn hẹp chỉ chạy macro #1664 với 25500 dòng & 255 cột mất >4.656" (file xls 112Mb)

Những sub này không chạy trực tiếp được.
vậy những sub này là sao ạ. AC giải thích giùm với.

Muốn chạy nó cần cung cấp cho nó tham biến {1 hay 2} Nhưng với dữ liệu đồ sộ của bạn thì quên nó đi!

noinhodayvoi20_10 · 28/11/18

SA_DQ đã viết:
Máy mình với bộ nhớ hạn hẹp chỉ chạy macro #1664 với 25500 dòng & 255 cột mất >4.656" (file xls 112Mb)

Muốn chạy nó cần cung cấp cho nó tham biến {1 hay 2} Nhưng với dữ liệu đồ sộ của bạn thì quên nó đi!

hic

Nhờ A giải thích giùm e khi nào thì mình sử dụng những sub như vậy ạ
Với những sub như vậy thì mục đích nó có khác gì với những sub bình thường ko A

lehuong1409 · 28/11/18

Em có Code VBA như ở trong file đính kèm em hay dùng để copy phần sau khi đã Filter (Như ví dụ dưới là em Filter ở Cột Mã hàng). Trước giờ em vẫn dùng Code này mà không hiểu nó thực hiện như thế nào vì em thấy giá trị trả về đã Paste Value như em mong muốn rồi nhưng hôm nay em không thực hiện Filter trước mà chạy Code luôn thì giá trị trả về có cả công thức ở phần trên xuống. Code hiện tại em đang dùng kiểu như này ạ

Mã:

Sub thu()
[A10:B20].Clear
[A1:B8].Copy [A10]
End Sub

Vậy Anh chị cho em hỏi phần [A1:B8].Copy [A10] Bản chất nó là như thế nào ạ (Copy Paste, Copy Paste Special Value hay một cách thức nào khác ạ).Em tự hiểu thì là không Filter là Copy Paste thông thường còn nếu Filter thì nó lại thành Copy Paste Special Value. Em muốn hiểu rõ hơn để áp dụng cho đúng và giải thích cho bạn bè khi cần ạ. Em cảm ơn ạ

♫ђöล♥ßล†♥†µ♫ · 28/11/18

lehuong1409 đã viết:
Em có Code VBA như ở trong file đính kèm em hay dùng để copy phần sau khi đã Filter (Như ví dụ dưới là em Filter ở Cột Mã hàng). Trước giờ em vẫn dùng Code này mà không hiểu nó thực hiện như thế nào vì em thấy giá trị trả về đã Paste Value như em mong muốn rồi nhưng hôm nay em không thực hiện Filter trước mà chạy Code luôn thì giá trị trả về có cả công thức ở phần trên xuống. Code hiện tại em đang dùng kiểu như này ạ

Mã:

Sub thu() [A10:B20].Clear [A1:B8].Copy [A10] End Sub

View attachment 208417
Vậy Anh chị cho em hỏi phần [A1:B8].Copy [A10] Bản chất nó là như thế nào ạ (Copy Paste, Copy Paste Special Value hay một cách thức nào khác ạ).Em tự hiểu thì là không Filter là Copy Paste thông thường còn nếu Filter thì nó lại thành Copy Paste Special Value. Em muốn hiểu rõ hơn để áp dụng cho đúng và giải thích cho bạn bè khi cần ạ. Em cảm ơn ạ

Người đẹp thử Code này xem sao

PHP:

Sub thu()
[A10:B20].Clear
[A1:B8].SpecialCells(12).Copy
[A10].PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

Tham khảo thêm: https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells
http://access-excel.tips/excel-vba-range-pastespecial/

lehuong1409 · 28/11/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Người đẹp thử Code này xem sao

PHP:

Sub thu() [A10:B20].Clear [A1:B8].SpecialCells(12).Copy [A10].PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub

Tham khảo thêm: https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells

Cái này nó lại bỏ hết Border của tớ đi rồi. Cậu thử xem file của tớ mà xem. Trước giờ tớ cứ dùng chứ nay mới thắc mắc nên lên diễn đàn hỏi cho hiểu sâu hơn tí ý mà

♫ђöล♥ßล†♥†µ♫ · 28/11/18

lehuong1409 đã viết:
Cái này nó lại bỏ hết Border của tớ đi rồi. Cậu thử xem file của tớ mà xem. Trước giờ tớ cứ dùng chứ nay mới thắc mắc nên lên diễn đàn hỏi cho hiểu sâu hơn tí ý mà

Vậy thêm 2 dòng nữa cho nó hoành tráng

PHP:

Sub thu()
Range("A10:B20").Clear
Range("A1:B8").SpecialCells(12).Copy
With Range("A10")
    .PasteSpecial xlPasteFormats
    .PasteSpecial xlPasteColumnWidths
   .PasteSpecial xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
End Sub

lehuong1409 · 28/11/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Vậy thêm 2 dòng nữa cho nó hoành tráng

PHP:

Sub thu() Range("A10:B20").Clear Range("A1:B8").SpecialCells(12).Copy With Range("A10") .PasteSpecial xlPasteFormats .PasteSpecial xlPasteColumnWidths .PasteSpecial xlPasteValues End With Application.CutCopyMode = False End Sub

Mã:

Sub thu()
[A10:B20].Clear
[A1:B8].Copy [A10]
End Sub

Code chỉ cần thế này là xử lý được rồi nhưng ý tớ là nếu tớ không Filter thì nó trả về kết quả có cả hàm mà Chỉ cần Filter ở Cột Mã hàng thì giá trị trả về tự động là Value luôn nên tớ thấy hay nên muốn hỏi bản chất của Code kia nó thay cho hàm hay thao tác nào trong Excel ý mà

♫ђöล♥ßล†♥†µ♫ · 28/11/18

lehuong1409 đã viết:
Mã:

Sub thu() [A10:B20].Clear [A1:B8].Copy [A10] End Sub

Code chỉ cần thế này là xử lý được rồi nhưng ý tớ là nếu tớ không Filter thì nó trả về kết quả có cả hàm mà Chỉ cần Filter ở Cột Mã hàng thì giá trị trả về tự động là Value luôn nên tớ thấy hay nên muốn hỏi bản chất của Code kia nó thay cho hàm hay thao tác nào trong Excel ý mà

Bản thân của Excel nó đã vậy rồi mà. Khi Copy 1 vùng đã được Filter thi nó cho kết quả là Value mà

lehuong1409 · 28/11/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Bản thân của Excel nó đã vậy rồi mà. Khi Copy 1 vùng đã được Filter thi nó cho kết quả là Value mà

điều đơn giản đấy mà hôm nay tớ mới biết đấy. Bình thường theo thói quen dùng paste Value là chính nên tớ còn không biết điều này. Cảm ơn ♫ђöล♥ßล†♥†µ♫ nhé. Thế về thực chất code kia của tớ chỉ là Copy Paste thông thường hihi

tonnydung · 28/11/18

tam888 đã viết:
Dùng cách dò tìm, trong VBA thì Range.Find.... tức là dùng method Find của Range

Code VBA em không được tốt lắm nhờ Anh/Chi viết giúp 1 đoạn code được không ah ?

Đoạn Code của Form nhập dữ liệu của em đây :

Private Sub cmdluukh_Click()
Dim lngRow As Long
Dim avDatakh

With ThisWorkbook.Worksheets("DS_KH_NCC")
lngRow = .Range("B" & .Rows.Count).End(xlUp).Row
If lngRow <= 3 Then
lngRow = 4
Else
lngRow = lngRow + 1
End If
ReDim avData(1 To 1, 1 To 12) As Variant
avData(1, 1) = lngRow - 3
avData(1, 2) = txtmakhncc.Text
avData(1, 3) = txtphanbiet.Text
avData(1, 4) = txttenkhncc.Text
avData(1, 5) = txthovatenkhncc.Text
avData(1, 6) = txtsodtkhncc.Text
avData(1, 7) = txtdiachikhncc.Text
avData(1, 8) = txtemailkhncc.Text
avData(1, 9) = txtsotkkhncc.Text
avData(1, 10) = txtghichu.Text
avData(1, 11) = txtnguoinhapds.Text
avData(1, 12) = VBA.Date 'ngay nhap
.Range("A1").Offset(lngRow - 1).Resize(, 12).value = avData

MsgBox "Da nhap DS KH-Nha Xe Thanh Cong vao o dong so: " & lngRow
End With
Call moi

End Sub

SA_DQ · 28/11/18

Nhờ A giải thích giùm e khi nào thì mình sử dụng những sub như vậy ạ
Với những sub như vậy thì mục đích nó có khác gì với những sub bình thường ko A

Bạn xem cái cặp này

Mã:

Sub GPE()
ThucHanh 13, 12.5, "B"
End Sub

PHP:

Sub ThucHanh(aA As Double, bB As Double, ABCDE As String)
  Select Case ABCDE
  Case "A"
    MsgBox aA + bB
Case "B"
    MsgBox aA - bB
Case "C"
    MsgBox aA * bB
Case "D"
    If bB <> 0 Then MsgBox aA / bB
Case "E"
    If bB <> 0 Then MsgBox aA \ bB
Case Else
    MsgBox "Không Làm, Xéo ngay!"
End Select
End Sub

tam888 · 28/11/18

tonnydung đã viết:
Code VBA em không được tốt lắm nhờ Anh/Chi viết giúp 1 đoạn code được không ah ?

Đoạn Code của Form nhập dữ liệu của em đây :

Private Sub cmdluukh_Click()
Dim lngRow As Long
Dim avDatakh

With ThisWorkbook.Worksheets("DS_KH_NCC")
lngRow = .Range("B" & .Rows.Count).End(xlUp).Row
If lngRow <= 3 Then
lngRow = 4
Else
lngRow = lngRow + 1
End If
ReDim avData(1 To 1, 1 To 12) As Variant
avData(1, 1) = lngRow - 3
avData(1, 2) = txtmakhncc.Text
avData(1, 3) = txtphanbiet.Text
avData(1, 4) = txttenkhncc.Text
avData(1, 5) = txthovatenkhncc.Text
avData(1, 6) = txtsodtkhncc.Text
avData(1, 7) = txtdiachikhncc.Text
avData(1, 8) = txtemailkhncc.Text
avData(1, 9) = txtsotkkhncc.Text
avData(1, 10) = txtghichu.Text
avData(1, 11) = txtnguoinhapds.Text
avData(1, 12) = VBA.Date 'ngay nhap
.Range("A1").Offset(lngRow - 1).Resize(, 12).value = avData

MsgBox "Da nhap DS KH-Nha Xe Thanh Cong vao o dong so: " & lngRow
End With
Call moi

End Sub

Thay đoạn code If ... EndIf đầu sub thành đoạn sau, xem có được không

Mã:

If lngRow <= 3 Then
    lngRow = 4
Else
    Dim Rg As Range
    Set Rg = .Range("B4:B" & lngRow).Find(txtmakhncc.Text,lookin:=xlValues, LookAt:=xlWhole)
    If Not Rg  Is Nothing Then
        Msgbox "Da co trung " & txtmakhncc.Text
        Exit sub
    End If
    lngRow = lngRow + 1
End If

VetMini · 29/11/18

SA_DQ đã viết:
Máy mình với bộ nhớ hạn hẹp chỉ chạy macro #1664 với 25500 dòng & 255 cột mất >4.656" (file xls 112Mb)

Muốn chạy nó cần cung cấp cho nó tham biến {1 hay 2} Nhưng với dữ liệu đồ sộ của bạn thì quên nó đi!

Đây là dân chơi hàng KHỦNG. Bạn vàng ơi.

noinhodayvoi20_10 đã viết:
Dữ liệu của mình trung bình 1 file csv 30Mb
Khoảng 4000 cột, gần 1tr dòng.
Chạy cái máy đơ lun

Cái từ "trung bình" ở trên hàm nghĩa rằng có nhiều files lắm, và có những files trên 4000 cột, trên triệu dòng. Tối thiểu 4 tỷ ô dữ liệu. Mỗi ô chỉ cần chứa 4 bytes dữ liệu (số thực) là mất bố nó 16 GB rồi !!!
Hàng này Access hay SQL Server Express (phiên bản chùa của SQL Server) cũng chịu thua, nói chi Excel.
Nếu dùng Excl 2016 thì may ra có thể dùng Power Query đưa nó vào Data Model để làm việc. Data Model ngầm chứa bộ máy SQL Server cho nên hy vọng sử lý dữ liệu khủng hiệu quả hơn.

noinhodayvoi20_10 · 29/11/18

VetMini đã viết:
Đây là dân chơi hàng KHỦNG. Bạn vàng ơi.

Cái từ "trung bình" ở trên hàm nghĩa rằng có nhiều files lắm, và có những files trên 4000 cột, trên triệu dòng. Tối thiểu 4 tỷ ô dữ liệu. Mỗi ô chỉ cần chứa 4 bytes dữ liệu (số thực) là mất bố nó 16 GB rồi !!!
Hàng này Access hay SQL Server Express (phiên bản chùa của SQL Server) cũng chịu thua, nói chi Excel.
Nếu dùng Excl 2016 thì may ra có thể dùng Power Query đưa nó vào Data Model để làm việc. Data Model ngầm chứa bộ máy SQL Server cho nên hy vọng sử lý dữ liệu khủng hiệu quả hơn.

Dạ. Đúng ra là tầm 3324 cột. 856.000 dòng
Mà file CSV tầm hơn 300 Mb à.
Cũng k hiểu sao nó nhẹ vậy.
Đinh chính là 300 chứ k phải 30

tueyennhi · 30/11/18

Trong code em dùng Dic, key của em có cái dạng số có cái dạng text (ví dụ 100 và '100). Làm thế nào để quy 2 cái này là cùng 1 key. Có cách nào chuyển đổi cái text kia sang số trước khi add vào Dic không?

Ba Tê · 30/11/18

tueyennhi đã viết:
Trong code em dùng Dic, key của em có cái dạng số có cái dạng text (ví dụ 100 và '100). Làm thế nào để quy 2 cái này là cùng 1 key. Có cách nào chuyển đổi cái text kia sang số trước khi add vào Dic không?

Val(Text) chuyển Text có dạng số thành Numer, CStr(Number) chuyển thành Text.

snow25 · 30/11/18

tueyennhi đã viết:
Trong code em dùng Dic, key của em có cái dạng số có cái dạng text (ví dụ 100 và '100). Làm thế nào để quy 2 cái này là cùng 1 key. Có cách nào chuyển đổi cái text kia sang số trước khi add vào Dic không?

Dơn giản hơn là khi bạn thêm 1 keys mới.Thì bạn gán luôn thuộc tính của nó là string.Bằng cách khai báo biến string rồi lấy giá trị cho nó bằng cái mà bạn định tạo mới.

tueyennhi · 30/11/18

Ba Tê đã viết:
Val(Text) chuyển Text có dạng số thành Numer, CStr(Number) chuyển thành Text.

Được rồi ạ, em cảm ơn anh nhé!

Bài đã được tự động gộp: 30/11/18

snow25 đã viết:
Dơn giản hơn là khi bạn thêm 1 keys mới.Thì bạn gán luôn thuộc tính của nó là string.Bằng cách khai báo biến string rồi lấy giá trị cho nó bằng cái mà bạn định tạo mới.

Mình chưa hiểu lắm, tem mình khai báo là as string rồi nhưng không thấy được.

Gà cận thị · 2/12/18

Chào mọi người em tập viết 1 Sub để hiển thị tên từng sheet và số lượng các sheet. Nhưng bị lỗi, nhờ mọi người giúp em với. Em xin cám ơn

Mã:

Sub Vonglap_For8()
    Dim mysheet As Worksheet 'Khai bao bien la Worksheet
    Dim i As Integer
    For Each mysheet In Worsheet 'Duyet qua tung Worksheet
    MsgBox mysheet.Name
    i = i + 1
    Next mysheet
    MsgBox "So sheets trong Worksheet la: " & i
End Sub

huonglien1901 · 2/12/18

Gà cận thị đã viết:
Chào mọi người em tập viết 1 Sub để hiển thị tên từng sheet và số lượng các sheet. Nhưng bị lỗi, nhờ mọi người giúp em với. Em xin cám ơn

Mã:

Sub Vonglap_For8() Dim mysheet As Worksheet 'Khai bao bien la Worksheet Dim i As Integer For Each mysheet In Worsheet 'Duyet qua tung Worksheet MsgBox mysheet.Name i = i + 1 Next mysheet MsgBox "So sheets trong Worksheet la: " & i End Sub

PHP:

Sub Vonglap_For8()
    Dim mysheet As Worksheet
    Dim i As Integer
    For Each mysheet In ActiveWorkbook.Worksheets
    
    MsgBox mysheet.Name
    i = i + 1
    Next mysheet
    MsgBox "So sheets trong Worksheet la: " & i
End Sub

Gà cận thị · 2/12/18

huonglien1901 đã viết:

PHP:

Sub Vonglap_For8()
    Dim mysheet As Worksheet
    Dim i As Integer
    For Each mysheet In ActiveWorkbook.Worksheets
   
    MsgBox mysheet.Name
    i = i + 1
    Next mysheet
    MsgBox "So sheets trong Worksheet la: " & i
End Sub

Cám ơn anh/chị nhiều !

VetMini · 2/12/18

i = i+1 chi vậy?
WorkSheets là một Collection. Collection có thuộc tính Count cho biết nó có bao nhiêu phần tử.

noinhodayvoi20_10 · 3/12/18

Chào mn ngày đầu tuần vv.
mọi người giúp e phương thức xác định dòng, cột cuối cùng chứa dữ liệu với ạ
bình thường e sử dụng 2 code sau :

Mã:

dim Lr_Row, Lr_Col as integer
    Lr_Row = Cells(Rows.Count, 1).End(xlUp).Row
    Lr_Col = Cells(1, Columns.Count).End(xlToLeft).Column

Tuy nhiên 2 dòng lệnh trên nó chỉ xác định được dòng và cột cuối ở cột A và dòng số 1.
Có nhiều file không thể xác định được là dòng nào hay cột nào chứa dữ liệu cuối cùng, do đó nếu sử dụng 2 dòng lệnh trên thì không đúng lắm.
mọi người có thể giúp e sử dụng cách nào tốt hơn không ạ.
xin cám ơn.

SA_DQ · 3/12/18

Xài fương thức FIND() đi bạn; luôn lúc nào cũng đạt iêu cầu bạn đề ra.

snow25 · 3/12/18

noinhodayvoi20_10 đã viết:
Chào mn ngày đầu tuần vv.
mọi người giúp e phương thức xác định dòng, cột cuối cùng chứa dữ liệu với ạ
bình thường e sử dụng 2 code sau :

Mã:

dim Lr_Row, Lr_Col as integer Lr_Row = Cells(Rows.Count, 1).End(xlUp).Row Lr_Col = Cells(1, Columns.Count).End(xlToLeft).Column

Tuy nhiên 2 dòng lệnh trên nó chỉ xác định được dòng và cột cuối ở cột A và dòng số 1.
Có nhiều file không thể xác định được là dòng nào hay cột nào chứa dữ liệu cuối cùng, do đó nếu sử dụng 2 dòng lệnh trên thì không đúng lắm.
mọi người có thể giúp e sử dụng cách nào tốt hơn không ạ.
xin cám ơn.

Bạn phải hiểu ở đây là bạn đang lấy ở dòng 1 va cột 1.Bạn có thể thay đổi dòng và cột mà.Thay số 1 thành số 2 nó khác ngay.Nó là dòng 2 và cột B đó.

Bài đã được tự động gộp: 3/12/18

SA_DQ đã viết:
Xài fương thức FIND() đi bạn; luôn lúc nào cũng đạt iêu cầu bạn đề ra.

Bạn hướng dẫn phương thức đó xem nào.FIND() đó.

SA_DQ · 3/12/18

https://www.giaiphapexcel.com/diend...ương-thức-tìm-kiếm-find-find-method.15116/#21

noinhodayvoi20_10 · 3/12/18

snow25 đã viết:
Bạn phải hiểu ở đây là bạn đang lấy ở dòng 1 va cột 1.Bạn có thể thay đổi dòng và cột mà.Thay số 1 thành số 2 nó khác ngay.Nó là dòng 2 và cột B đó.

Bài đã được tự động gộp: 3/12/18

Bạn hướng dẫn phương thức đó xem nào.FIND() đó.

bạn hiểu ko : vì là dữ liệu mình hơn 4000 cột, bây giờ đâu xác định được cột nào là có dữ liệu dài nhất để mà chọn "A" Hay là "X" ???

snow25 · 3/12/18

noinhodayvoi20_10 đã viết:
bạn hiểu ko : vì là dữ liệu mình hơn 4000 cột, bây giờ đâu xác định được cột nào là có dữ liệu dài nhất để mà chọn "A" Hay là "X" ???

À vậy thì xác định dòng lớn nhất trong đó.
Vậy bạn thử.

Mã:

Sub xacdinhsodong()
Dim a As Long
With Sheet1
a = .UsedRange.Rows.Count
MsgBox a
End With
End Sub

Gà cận thị · 3/12/18

VetMini đã viết:
i = i+1 chi vậy?
WorkSheets là một Collection. Collection có thuộc tính Count cho biết nó có bao nhiêu phần tử.

Nếu không có dòng: i=i+1
thì số sheet sẽ bằng không thì sao anh ?
hay còn có cái gì khác, em chưa hiểu ý chổ này lắm !

noinhodayvoi20_10 · 3/12/18

snow25 đã viết:
À vậy thì xác định dòng lớn nhất trong đó.
Vậy bạn thử.

Mã:

Sub xacdinhsodong() Dim a As Long With Sheet1 a = .UsedRange.Rows.Count MsgBox a End With End Sub

Cám ơn ! Code này có hiệu quả. Vậy liệu mình bỏ with đi
Gắn cho a = sheet1.usedrange.rows.count đc k nhỉ

snow25 · 3/12/18

noinhodayvoi20_10 đã viết:
Cám ơn ! Code này có hiệu quả. Vậy liệu mình bỏ with đi
Gắn cho a = sheet1.usedrange.rows.count đc k nhỉ

Được nó vẫn như nhau mà.

Bài đã được tự động gộp: 3/12/18

Gà cận thị đã viết:
Nếu không có dòng: i=i+1
thì số sheet sẽ bằng không thì sao anh ?
hay còn có cái gì khác, em chưa hiểu ý chổ này lắm !

Bạn có thể thay bằng thế này.

Mã:

Sub Vonglap_For8()
    Dim mysheet As Worksheet
    Dim i As Integer
    For Each mysheet In ActiveWorkbook.Worksheets
  
    MsgBox mysheet.Name
    MsgBox "So sheets trong Worksheet la: " & mysheet.Index
    Next mysheet
    
End Sub

Gà cận thị · 3/12/18

snow25 đã viết:
Được nó vẫn như nhau mà.

Bài đã được tự động gộp: 3/12/18

Bạn có thể thay bằng thế này.

Mã:

Sub Vonglap_For8() Dim mysheet As Worksheet Dim i As Integer For Each mysheet In ActiveWorkbook.Worksheets MsgBox mysheet.Name MsgBox "So sheets trong Worksheet la: " & mysheet.Index Next mysheet End Sub

Cách này cũng hay, nhưng nếu số sheet nhiều lên thì mau hư chuột lắm anh ! :cray:

snow25 · 3/12/18

Gà cận thị đã viết:
Cách này cũng hay, nhưng nếu số sheet nhiều lên thì mau hư chuột lắm anh !

Bạn muốn xem có bao nhiêu sheets à.Mình tưởng hiện thị từng sheets.

Mã:

Sub Vonglap_For8()
    Dim mysheet As Worksheet
    Dim i As Integer
    For Each mysheet In ActiveWorkbook.Worksheets

    MsgBox mysheet.Name
   
    Next mysheet
   MsgBox "So sheets trong Worksheet la: " & Sheets.Count
End Sub

Gà cận thị · 3/12/18

snow25 đã viết:
Bạn muốn xem có bao nhiêu sheets à.Mình tưởng hiện thị từng sheets.

Mã:

Sub Vonglap_For8() Dim mysheet As Worksheet Dim i As Integer For Each mysheet In ActiveWorkbook.Worksheets MsgBox mysheet.Name Next mysheet MsgBox "So sheets trong Worksheet la: " & Sheets.Count End Sub

Híc cái tưởng nhầm của anh mà hóa ra lại hay với em.

quangchinhtdc · 4/12/18

Mình mới tập tành làm code VBA phục vụ công việc. Mình có thắc mắc muốn nhờ giải đáp giúp.
Mình có file dùng Vlookup để in nhiều phần khác nhau với 1 khuôn giống nhau. Và đã có dùng VBA để in số lượng lớn giấy với 1 thao tác.
Nhưng khi mình dùng hàm For To Next để in thì chỉ thực hiện được từ số nhỏ đến số lớn.
Vậy có cách nào để mình in với số lượng lớn từ lớn đến nhỏ được không?

Ba Tê · 4/12/18

quangchinhtdc đã viết:
Mình mới tập tành làm code VBA phục vụ công việc. Mình có thắc mắc muốn nhờ giải đáp giúp.
Mình có file dùng Vlookup để in nhiều phần khác nhau với 1 khuôn giống nhau. Và đã có dùng VBA để in số lượng lớn giấy với 1 thao tác.
Nhưng khi mình dùng hàm For To Next để in thì chỉ thực hiện được từ số nhỏ đến số lớn.
Vậy có cách nào để mình in với số lượng lớn từ lớn đến nhỏ được không?

Được!
For I=lớn To nhỏ Step - mấy

VetMini · 4/12/18

For số = nhỏ To lớn
thì vòng lặp đi từ số nhỏ sang lớn, từng bước một.

For số = lớn To nhỏ Step -1
thì vòng lặp đi từ lớn xuống nhỏ, từng bước một. Đừng quên cái chỗ Step -1

tonnydung · 4/12/18

tam888 đã viết:
Thay đoạn code If ... EndIf đầu sub thành đoạn sau, xem có được không

Mã:

If lngRow <= 3 Then lngRow = 4 Else Dim Rg As Range Set Rg = .Range("B4:B" & lngRow).Find(txtmakhncc.Text,lookin:=xlValues, LookAt:=xlWhole) If Not Rg Is Nothing Then Msgbox "Da co trung " & txtmakhncc.Text Exit sub End If lngRow = lngRow + 1 End If

Em làm được rồi, Tks bác nhiều. Nhưng em muốn thêm điều kiện nữa như sau thì phải thêm như nào (phần điều kiện trên vẫn giữ song song với điều kiện dưới đây):
- Trong file excell ở cột C4:C (là dữ liệu ở Textboxt "txtphanbiet.Text" nhập vào mà có chữ "kh") thì sẽ kiểm tra điều kiện cột E4:E (cột này là cột của Textboxt "txtsodtkhncc.Text" được nhập vào mà dữ liệu đã có thì cũng báo trùng và ko cho nhập (lưu ý chỉ ktra khi cột C là chữ "kh")

Em có VD trong file attch kèm theo.

=> giờ em phải thêm code VBA điều kiện như nào ah ? Rất mong cả nhà giúp đỡ.

tam888 · 4/12/18

tonnydung đã viết:
Em làm được rồi, Tks bác nhiều. Nhưng em muốn thêm điều kiện nữa như sau thì phải thêm như nào (phần điều kiện trên vẫn giữ song song với điều kiện dưới đây):
- Trong file excell ở cột C4:C (là dữ liệu ở Textboxt "txtphanbiet.Text" nhập vào mà có chữ "kh") thì sẽ kiểm tra điều kiện cột E4:E (cột này là cột của Textboxt "txtsodtkhncc.Text" được nhập vào mà dữ liệu đã có thì cũng báo trùng và ko cho nhập (lưu ý chỉ ktra khi cột C là chữ "kh")

Em có VD trong file attch kèm theo.

=> giờ em phải thêm code VBA điều kiện như nào ah ? Rất mong cả nhà giúp đỡ.

Đưa file kiểu này thì sao test đúng sai, nên bạn thử làm đi rồi gửi lên đây hỏi tiếp nếu mắc

tonnydung · 5/12/18

tam888 đã viết:
Đưa file kiểu này thì sao test đúng sai, nên bạn thử làm đi rồi gửi lên đây hỏi tiếp nếu mắc

Vậy em muốn bỏ qua việc set "kh" giờ em chỉ set 2 mục
("B4:B" & lngRow).Find(txtmakhncc.Text, LookIn:=xlValues, LookAt:=xlWhole) và ("F4:F" & lngRow).Find(txtsodtkhncc.Text, LookIn:=xlValues, LookAt:=xlWhole) anh giup em doan Code VBA của nó sẽ phải viết như nào ah ?

tam888 · 5/12/18

tonnydung đã viết:
Vậy em muốn bỏ qua việc set "kh" giờ em chỉ set 2 mục
("B4:B" & lngRow).Find(txtmakhncc.Text, LookIn:=xlValues, LookAt:=xlWhole) và ("F4:F" & lngRow).Find(txtsodtkhncc.Text, LookIn:=xlValues, LookAt:=xlWhole) anh giup em doan Code VBA của nó sẽ phải viết như nào ah ?

Thì cũng vậy bạn phải tự thân vận động , sáng tạo lên, đừng cứ chờ ù ì sẽ bao giờ lên tay
Đây, thử thế này

Mã:

If lngRow <= 3 Then
    lngRow = 4
Else
    'Kiem tra trung Ma
    Dim Rg As Range
    Set Rg = .Range("B4:B" & lngRow).Find(txtmakhncc.Text,lookin:=xlValues, LookAt:=xlWhole)
    If Not Rg  Is Nothing Then
        Msgbox "Da co trung " & txtmakhncc.Text
        Exit sub
    End If
  
    'Kiem tra trung so dt
    Set Rg = Nothing
     Set Rg = .Range("F4:F" & lngRow).Find(txtsodtkhncc.Text,lookin:=xlValues, LookAt:=xlWhole)
    If Not Rg  Is Nothing Then
        Msgbox "Da co trung " & txtsodtkhncc.Text
        Exit sub
    End If
  
    lngRow = lngRow + 1
End If

tueyennhi · 7/12/18

Cho em hỏi đoạn code này có gì sai?

PHP:

Public Sub CongToCompare()
    Dim Ws As Worksheet
    Dim Arr(), i As Long, j As Long, k As Long
    Dim SoSheet As Byte
  
    SoSheet = Application.Sheets.Count
  
    ReDim Result(1 To SoSheet * 50000, 1 To 10)
    With Workbooks("(E) Daily Attendance(Upload)(V)(H4006M1_VN).xls")
        For Each Ws In .Worksheets
            Arr = Ws.Range("A5", Ws.Range("A50000").End(xlUp)).Resize(, 10).Value2
            For i = 1 To UBound(Arr, 1)
                If Len(Arr(i, 2)) = 5 Then
                    k = k + 1
                    For j = 1 To 10
                        Result(k, j) = Arr(i, j)
                    Next j
                End If
            Next i
        Next Ws
    End With

    With Workbooks("Balance MrT and ERP.xlsb")
        .Sheets("Data").Range("C5").Resize(k, 10) = Result
    End With
  
End Sub

Đoạn code này nằm trong file Balance MrT and ERP.xlsb và là file đang làm việc. Khi em chạy code thì dữ liệu lấy từ file (E) Daily Attendance(Upload)(V)(H4006M1_VN).xls sang bị thiếu là sao nhỉ? Không biết cái For each của em có vấn đề gì không mà lại vậy

vanthinh3101 · 7/12/18

tueyennhi đã viết:
Cho em hỏi đoạn code này có gì sai?

PHP:

Public Sub CongToCompare() Dim Ws As Worksheet Dim Arr(), i As Long, j As Long, k As Long Dim SoSheet As Byte SoSheet = Application.Sheets.Count ReDim Result(1 To SoSheet * 50000, 1 To 10) With Workbooks("(E) Daily Attendance(Upload)(V)(H4006M1_VN).xls") For Each Ws In .Worksheets Arr = Ws.Range("A5", Ws.Range("A50000").End(xlUp)).Resize(, 10).Value2 For i = 1 To UBound(Arr, 1) If Len(Arr(i, 2)) = 5 Then k = k + 1 For j = 1 To 10 Result(k, j) = Arr(i, j) Next j End If Next i Next Ws End With With Workbooks("Balance MrT and ERP.xlsb") .Sheets("Data").Range("C5").Resize(k, 10) = Result End With End Sub

Đoạn code này nằm trong file Balance MrT and ERP.xlsb và là file đang làm việc. Khi em chạy code thì dữ liệu lấy từ file (E) Daily Attendance(Upload)(V)(H4006M1_VN).xls sang bị thiếu là sao nhỉ? Không biết cái For each của em có vấn đề gì không mà lại vậy

Bạn kiểm tra: file (E) Daily Attendance(Upload)(V)(H4006M1_VN).xls có đang mở không?
Nếu không mở thì không chạy được nhé!
Bổ sung: Trường hợp này có thể dùng ADO để lấy dữ liệu từ file đang đóng, như vậy sẽ nhanh hơn.

tueyennhi · 7/12/18

vanthinh3101 đã viết:
Bạn kiểm tra: file (E) Daily Attendance(Upload)(V)(H4006M1_VN).xls có đang mở không?
Nếu không mở thì không chạy được nhé!
Bổ sung: Trường hợp này có thể dùng ADO để lấy dữ liệu từ file đang đóng, như vậy sẽ nhanh hơn.

File của mình vẫn mở, dữ liệu lấy được chỉ là nó không lấy đủ.

Mình có sưu tập được đoạn code này nhưng áp dụng file mình thì nó không chạy, không hiểu sao luôn.
File của mình có nhiều sheet nhưng dữ liệu form là như nhau, tại ô A1 luôn là tiêu đề.

Dữ liệu bắt đầu có từ dòng 5 cột A đến cột J. (Vài vạn dòng)
Nó báo lỗi tại dòng: rst.Open SQL, cnn, 3, 3, 1 là Run-time error '450' Wrong number of arguments or invalid property assignment

PHP:

Sub NMH()
    Dim cnn As Object, rst As Object
    Dim SQL$, Ws As Worksheet
        Set cnn = CreateObject("ADODB.Connection")
        Set rst = CreateObject("ADODB.Connection")
        With cnn
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                "Data source=" & ThisWorkbook.FullName & _
                                ";Extended properties=""Excel 12.0;IMEX=1;HDR=Yes"";"
            .Open
        End With
        For Each Ws In Worksheets
            If Ws.CodeName <> "Result" Then SQL = SQL & " " & "[" & Ws.Name & "$A5:J]"
        Next
        SQL = "SELECT * FROM " & Replace(Trim(SQL), " ", " UNION ALL SELECT * FROM ")
        rst.Open SQL, cnn, 3, 3, 1
        [A2].CopyFromRecordset rst
        rst.Close: Set rst = Nothing
        cnn.Close: Set cnn = Nothing
End Sub

VetMini · 7/12/18

Cốt ấy hốt ở đâu ra vậy?
Đem qua hộp CSDL hỏi. Và réo tên cái "chị" xinh xinh với cái tên phản cảm "ổ tơ ổ rệp" gì đó.

snow25 · 7/12/18

tueyennhi đã viết:
Cho em hỏi đoạn code này có gì sai?

PHP:

Public Sub CongToCompare() Dim Ws As Worksheet Dim Arr(), i As Long, j As Long, k As Long Dim SoSheet As Byte SoSheet = Application.Sheets.Count ReDim Result(1 To SoSheet * 50000, 1 To 10) With Workbooks("(E) Daily Attendance(Upload)(V)(H4006M1_VN).xls") For Each Ws In .Worksheets Arr = Ws.Range("A5", Ws.Range("A50000").End(xlUp)).Resize(, 10).Value2 For i = 1 To UBound(Arr, 1) If Len(Arr(i, 2)) = 5 Then k = k + 1 For j = 1 To 10 Result(k, j) = Arr(i, j) Next j End If Next i Next Ws End With With Workbooks("Balance MrT and ERP.xlsb") .Sheets("Data").Range("C5").Resize(k, 10) = Result End With End Sub

Đoạn code này nằm trong file Balance MrT and ERP.xlsb và là file đang làm việc. Khi em chạy code thì dữ liệu lấy từ file (E) Daily Attendance(Upload)(V)(H4006M1_VN).xls sang bị thiếu là sao nhỉ? Không biết cái For each của em có vấn đề gì không mà lại vậy

Theo mình thì bạn thử tăng cái này lên.vì nếu dữ liệu vượt quá 50000 dòng thì là lỗi.
Arr = Ws.Range("A5", Ws.Range("A50000").End(xlUp)).Resize(, 10).Value2

tueyennhi · 7/12/18

snow25 đã viết:
Theo mình thì bạn thử tăng cái này lên.vì nếu dữ liệu vượt quá 50000 dòng thì là lỗi.
Arr = Ws.Range("A5", Ws.Range("A50000").End(xlUp)).Resize(, 10).Value2

Bạn ơi không báo lỗi mà chỉ là dữ liệu mình không đủ thôi. Ngoài ra đây là vùng dữ liệu mình cần lấy cho nên tăng cái này thêm bao nhiêu thì kết quả vẫn vậy

snow25 · 7/12/18

tueyennhi đã viết:
Bạn ơi không báo lỗi mà chỉ là dữ liệu mình không đủ thôi. Ngoài ra đây là vùng dữ liệu mình cần lấy cho nên tăng cái này thêm bao nhiêu thì kết quả vẫn vậy

Đây là câu lệnh gán dữ liệu vào mảng .Nó sẽ không báo lỗi khi dữ liệu của bạn vượt quá 50.000.Mà nó lấy thiếu dữ liệu vào mảng đó.Nên khi dữ liệu ra sẽ bị thiếu.

tueyennhi · 7/12/18

snow25 đã viết:
Đây là câu lệnh gán dữ liệu vào mảng .Nó sẽ không báo lỗi khi dữ liệu của bạn vượt quá 50.000.Mà nó lấy thiếu dữ liệu vào mảng đó.Nên khi dữ liệu ra sẽ bị thiếu.

Uh mình hiểu, nhưng mình biết dữ liệu nó chỉ đến đó thôi bạn ạ, vậy mới khó hiểu

(. Dữ liệu đến đúng dòng 50.000

VetMini · 7/12/18

Ở đấy mà bàn với đoán mò.
Cứ việc bảo nó in ra cái range đó rồi tính tiếp:
Debug.Print Ws.Range("A5", Ws.Range("A50000").End(xlUp)).Resize(, 10).Address

HeSanbi · 7/12/18

tueyennhi đã viết:
Cho em hỏi đoạn code này có gì sai?

PHP:

Public Sub CongToCompare() Dim Ws As Worksheet Dim Arr(), i As Long, j As Long, k As Long Dim SoSheet As Byte SoSheet = Application.Sheets.Count ReDim Result(1 To SoSheet * 50000, 1 To 10) With Workbooks("(E) Daily Attendance(Upload)(V)(H4006M1_VN).xls") For Each Ws In .Worksheets Arr = Ws.Range("A5", Ws.Range("A50000").End(xlUp)).Resize(, 10).Value2 For i = 1 To UBound(Arr, 1) If Len(Arr(i, 2)) = 5 Then k = k + 1 For j = 1 To 10 Result(k, j) = Arr(i, j) Next j End If Next i Next Ws End With With Workbooks("Balance MrT and ERP.xlsb") .Sheets("Data").Range("C5").Resize(k, 10) = Result End With End Sub

Đoạn code này nằm trong file Balance MrT and ERP.xlsb và là file đang làm việc. Khi em chạy code thì dữ liệu lấy từ file (E) Daily Attendance(Upload)(V)(H4006M1_VN).xls sang bị thiếu là sao nhỉ? Không biết cái For each của em có vấn đề gì không mà lại vậy

Thấy bàng tán sôi nổi. Nên Chọt vào sửa code. Không được thì thôi nhé

Mã:

Public Sub CongToCompare()
    Dim Ws As Worksheet, Result As Variant, Arr(), i As Long, j As Long, k As Long

    With Workbooks("(E) Daily Attendance(Upload)(V)(H4006M1_VN).xls")
        For Each Ws In .Worksheets
            Arr = Ws.Range("A5", Ws.Range("A65000").End(xlUp)).Resize(, 10).Value2
            For i = 1 To UBound(Arr, 1)
                If Len(Arr(i, 2)) = 5 Then
                    k = k + 1
                    ReDim Preserve Result(1 To 10, 1 To k)
                    For j = 1 To 10
                        Result(j, k) = Arr(i, j)
                    Next j
                End If
            Next i
        Next Ws
    End With

    With Workbooks("Balance MrT and ERP.xlsb")
        .Sheets("Data").Range("C5").Resize(k, 10) = Application.WorksheetFunction.Transpose(Result)
    End With

End Sub

------------------------- Tham Khảo---------------------------------------------
Kiểm thử kết quả Mảng trong Immediate với hàm dbPrint
Đánh thứ tự ký tự bằng Hàm hoặc Code - Sử dụng toán chỉnh hợp

kienphamiuh · 8/12/18

-em có 1 vấn đề nhờ các anh chị trong group giúp ạ
-em có 1 File excel ( sheep 1 là "thông tin", sheep 2 là "file tổng")
+ em sử dụng làm Vlookup để lấy thông tin từ "file tổng" chuyển qua file " thông tin" dựa vào Mã HV
+ Vấn đề em gặp là Vlookup chỉ lấy được giá trị mà không lấy đc: màu sắc của ô ( ô được tô màu vàng ), comment, màu sắc của chữ ( chữ màu đỏ ).
- em mong anh chị giúp tạo 1 hàm Xlookup có chức năng như Vlookup nhưng lấy được giá trị và cả (màu sắc của ô,comment, màu sắc của chữ ) , còn nếu không thể làm 1 hàm như Xlookup anh chị giúp em viết code lấy giá trị và màu sắc của ô,comment, màu sắc của chữ dựa vào mã HV trong file " thông tin" ạ
vd: =Xlookup ( X, Y ,Z ,0 or 1)
X là Giá trị dùng để dò tìm
Y là Bảng giá trị dò
Z là Thứ tự của cột cần lấy dữ liệu trên bảng giá trị dò
0 là giá trị tuyệt đối
X Y Z là các giá trị mình nhập, mong các anh chị giúp, em cảm ơn nhiều ạ

em có viết 1 đoan VBA như sau :
Function Xlookup(cn As String)
Xlookup = Sheet2.Range("a:a").Find(cn).Offset(, 1).Value
End Function
nhưng nhựơc điểm là không linh động cột cần lấy, mỗi lần lấy phải vào code sửa offset và không lấy được màu sắc của ô,comment, màu sắc của chữ ( còn thua xài vlookup nữa anh chị ạ

( )

Hoàng Nhật Phương · 8/12/18

kienphamiuh đã viết:
-em có 1 vấn đề nhờ các anh chị trong group giúp ạ
-em có 1 File excel ( sheep 1 là "thông tin", sheep 2 là "file tổng")
+ em sử dụng làm Vlookup để lấy thông tin từ "file tổng" chuyển qua file " thông tin" dựa vào Mã HV
+ Vấn đề em gặp là Vlookup chỉ lấy được giá trị mà không lấy đc: màu sắc của ô ( ô được tô màu vàng ), comment, màu sắc của chữ ( chữ màu đỏ ).
- em mong anh chị giúp tạo 1 hàm Xlookup có chức năng như Vlookup nhưng lấy được giá trị và cả (màu sắc của ô,comment, màu sắc của chữ ) , còn nếu không thể làm 1 hàm như Xlookup anh chị giúp em viết code lấy giá trị và màu sắc của ô,comment, màu sắc của chữ dựa vào mã HV trong file " thông tin" ạ
vd: =Xlookup ( X, Y ,Z ,0 or 1)
X là Giá trị dùng để dò tìm
Y là Bảng giá trị dò
Z là Thứ tự của cột cần lấy dữ liệu trên bảng giá trị dò
0 là giá trị tuyệt đối
X Y Z là các giá trị mình nhập, mong các anh chị giúp, em cảm ơn nhiều ạ

em có viết 1 đoan VBA như sau :
Function Xlookup(cn As String)
Xlookup = Sheet2.Range("a:a").Find(cn).Offset(, 1).Value
End Function
nhưng nhựơc điểm là không linh động cột cần lấy, mỗi lần lấy phải vào code sửa offset và không lấy được màu sắc của ô,comment, màu sắc của chữ ( còn thua xài vlookup nữa anh chị ạ ( )

Xin chào @kienphamiuh ,
Oanh Thơ (OT) không thể tạo được Function Xlookup theo mong muốn của bạn, trong khi chờ đợi bạn dùng tạm sub FindAndCopyPase xem được không?

Mã:

Sub FindAndCopyPase()
    Dim lastRow As Long, i As Long, varKey As Variant
    Dim c As Range, shtData As Worksheet, shtKQ As Worksheet
    Set shtData = ThisWorkbook.Worksheets("Sheet2")
    Set shtKQ = ThisWorkbook.Worksheets("Sheet1")
    With shtKQ
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        varKey = .Range("A2:A" & lastRow)
    End With
    With shtData
        For i = LBound(varKey) To UBound(varKey)
            Set c = .Columns("A").Find(What:=varKey(i, 1), _
                After:=.Range("A1"), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchDirection:=xlNext)
            If c Is Nothing Then
                shtKQ.Cells(i + 1, 2).Value = "#N/A"
            Else
                c.Resize(1, 2).Offset(0, 1).Copy Destination:=shtKQ.Cells(i + 1, 2)
            End If
        Next i
    End With
End Sub

-------------
Ngoài ra, OT góp ý chút với bạn.
Trường hợp của bạn nên tạo một chủ đề mới, còn trong chủ đề này có thể chỉ trao đổi những vấn đề liên quan đến code có sẵn.

kienphamiuh · 8/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào @kienphamiuh ,
Oanh Thơ (OT) không thể tạo được Function Xlookup theo mong muốn của bạn, trong khi chờ đợi bạn dùng tạm sub FindAndCopyPase xem được không?

Mã:

Sub FindAndCopyPase() Dim lastRow As Long, i As Long, varKey As Variant Dim c As Range, shtData As Worksheet, shtKQ As Worksheet Set shtData = ThisWorkbook.Worksheets("Sheet2") Set shtKQ = ThisWorkbook.Worksheets("Sheet1") With shtKQ lastRow = .Range("A" & .Rows.Count).End(xlUp).Row varKey = .Range("A2:A" & lastRow) End With With shtData For i = LBound(varKey) To UBound(varKey) Set c = .Columns("A").Find(What:=varKey(i, 1), _ After:=.Range("A1"), LookIn:=xlValues, _ LookAt:=xlWhole, SearchDirection:=xlNext) If c Is Nothing Then shtKQ.Cells(i + 1, 2).Value = "#N/A" Else c.Resize(1, 2).Offset(0, 1).Copy Destination:=shtKQ.Cells(i + 1, 2) End If Next i End With End Sub

-------------
Ngoài ra, OT góp ý chút với bạn.
Trường hợp của bạn nên tạo một chủ đề mới, còn trong chủ đề này có thể chỉ trao đổi những vấn đề liên quan đến code có sẵn.

cảm ơn bạn mình sẽ tạo 1 chủ đề, công việc của mình liên quan đến mấy cái này , hôm nào cũng copy paste coment với màu sắc bằng thủ công mà nản ghê luôn

Hoàng Nhật Phương · 9/12/18

tueyennhi đã viết:
File của mình vẫn mở, dữ liệu lấy được chỉ là nó không lấy đủ.

Mình có sưu tập được đoạn code này nhưng áp dụng file mình thì nó không chạy, không hiểu sao luôn.
File của mình có nhiều sheet nhưng dữ liệu form là như nhau, tại ô A1 luôn là tiêu đề.

Dữ liệu bắt đầu có từ dòng 5 cột A đến cột J. (Vài vạn dòng)
Nó báo lỗi tại dòng: rst.Open SQL, cnn, 3, 3, 1 là Run-time error '450' Wrong number of arguments or invalid property assignment

PHP:

Sub NMH() Dim cnn As Object, rst As Object Dim SQL$, Ws As Worksheet Set cnn = CreateObject("ADODB.Connection") Set rst = CreateObject("ADODB.Connection") With cnn .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data source=" & ThisWorkbook.FullName & _ ";Extended properties=""Excel 12.0;IMEX=1;HDR=Yes"";" .Open End With For Each Ws In Worksheets If Ws.CodeName <> "Result" Then SQL = SQL & " " & "[" & Ws.Name & "$A5:J]" Next SQL = "SELECT * FROM " & Replace(Trim(SQL), " ", " UNION ALL SELECT * FROM ") rst.Open SQL, cnn, 3, 3, 1 [A2].CopyFromRecordset rst rst.Close: Set rst = Nothing cnn.Close: Set cnn = Nothing End Sub

Hi @tueyennhi , bạn thử:
Thay:

Mã:

Set rst = CreateObject("ADODB.Connection")

thành:

Mã:

Set rst = CreateObject("ADODB.Recordset")

và thay:

Mã:

If Ws.CodeName <> "Result"

thành:

Mã:

If Ws.CodeName <> "Sheet5"

Và sửa:

Mã:

Sheet1 (2)= Sheet2,
Sheet1 (3)= Sheet3,
Sheet1 (4)= Sheet4
Bỏ tất cả tất cả những gì sau khoảng trống.

Xem thế nào ạ.

tueyennhi · 12/12/18

VetMini đã viết:
Cốt ấy hốt ở đâu ra vậy?
Đem qua hộp CSDL hỏi. Và réo tên cái "chị" xinh xinh với cái tên phản cảm "ổ tơ ổ rệp" gì đó.

Vâng anh, code này em có từ khá lâu rồi giờ không nhớ ở chủ đề nào để hỏi. Chị xinh xinh có phải là Autoreply không anh

vì em thấy chị đó like anh và ảnh đại diện thì rất xinh.

Bài đã được tự động gộp: 12/12/18

HeSanbi đã viết:

Thấy bàng tán sôi nổi. Nên Chọt vào sửa code. Không được thì thôi nhé

Mã:

Public Sub CongToCompare()
    Dim Ws As Worksheet, Result As Variant, Arr(), i As Long, j As Long, k As Long

    With Workbooks("(E) Daily Attendance(Upload)(V)(H4006M1_VN).xls")
        For Each Ws In .Worksheets
            Arr = Ws.Range("A5", Ws.Range("A65000").End(xlUp)).Resize(, 10).Value2
            For i = 1 To UBound(Arr, 1)
                If Len(Arr(i, 2)) = 5 Then
                    k = k + 1
                    ReDim Preserve Result(1 To 10, 1 To k)
                    For j = 1 To 10
                        Result(j, k) = Arr(i, j)
                    Next j
                End If
            Next i
        Next Ws
    End With

    With Workbooks("Balance MrT and ERP.xlsb")
        .Sheets("Data").Range("C5").Resize(k, 10) = Application.WorksheetFunction.Transpose(Result)
    End With

End Sub

Để mình thử, cảm ơn bạn nhé.

tueyennhi · 12/12/18

Nguyễn Hoàng Oanh Thơ đã viết:
Hi @tueyennhi , bạn thử:
Thay:

Mã:

Set rst = CreateObject("ADODB.Connection")

thành:

Mã:

Set rst = CreateObject("ADODB.Recordset")

và thay:

Mã:

If Ws.CodeName <> "Result"

thành:

Mã:

If Ws.CodeName <> "Sheet5"

Và sửa:

Mã:

Sheet1 (2)= Sheet2, Sheet1 (3)= Sheet3, Sheet1 (4)= Sheet4 Bỏ tất cả tất cả những gì sau khoảng trống.

Xem thế nào ạ.

Sau khi sửa lại tên sheet thì code đã chạy. Nhưng mình thấy mỗi một sheet sẽ mất đi một dòng. Sửa lại đoạn này

PHP:

...
If Ws.CodeName <> "Result" Then SQL = SQL & " " & "[" & Ws.Name & "$A5:J]"
...

thành

PHP:

...
If Ws.CodeName <> "Result" Then SQL = SQL & " " & "[" & Ws.Name & "$A4:J]"
...

thì dữ liệu đã được lấy đủ.

VetMini · 12/12/18

tueyennhi đã viết:
Vâng anh, code này em có từ khá lâu rồi giờ không nhớ ở chủ đề nào để hỏi. Chị xinh xinh có phải là Autoreply không anh vì em thấy chị đó like anh và ảnh đại diện thì rất xinh.
...

Dùng từ "like" cẩn thận. Nó có hai nghĩa:
1. giống - tôi không dám nhận "giống cô ta" đâu
2. thích - tôi lại càng không dám nhận, "cô" hay "cậu" gì tôi cũng chạy hết.

tueyennhi · 12/12/18

VetMini đã viết:
Dùng từ "like" cẩn thận. Nó có hai nghĩa:
1. giống - tôi không dám nhận "giống cô ta" đâu
2. thích - tôi lại càng không dám nhận, "cô" hay "cậu" gì tôi cũng chạy hết.

Em chỉ mô tả hành động của chị "ổ tơ ổ rệp" thôi mà. Thôi thì thích câu nói của anh

Sunbinsuzin · 12/12/18

Em cần gửi lệnh in tới cửa sổ ứng dụng khác thông qua VBA. Code em viết
Sub Text()
AppActivate("Filetext")
Application.Wait Now + TimeValue("0:00:01")
Application.SendKeys "%P"
Application.Wait Now + TimeValue("0:00:01")
Application.SendKeys "~"
End Sub
Code chạy nhưng dòng
Application.SendKeys "%P"
Không thấy bật PrintPreview
Các bác giúp em với

befaint · 12/12/18

Sunbinsuzin đã viết:
Ko hoạt động

Cho những thứ là code, là công thức vào chỗ chuyên chứa nó. Thấy người ta làm được thì mình cố làm cho giống vậy.

"Ko" là ứng dụng gì?

"Ko" hoạt động rồi thì hỏi làm gì nữa?

TUTRUNGHIEU · 12/12/18

Em chào các Admin và các anh chị!
Em không biết đăng bài vào đây có đúng chuyên mục không, có gì sai mong anh chị thông cảm giúp đỡ em ạ!
Em có 1 file Đơn hàng cần dùng vba để tìm lọc dữ liệu của 2 hoặc nhiều sheet về 1 sheet theo như các yêu cầu có ghi chú trong file đính kèm. Em mới biết sơ xài về VBA nên mong các anh chị giúp đỡ ạ!

batman1 · 13/12/18

Sunbinsuzin đã viết:
Em cần gửi lệnh in tới cửa sổ ứng dụng khác thông qua VBA. Code em viết
Sub Text()
AppActivate("Filetext")
Application.Wait Now + TimeValue("0:00:01")
Application.SendKeys "%P"
Application.Wait Now + TimeValue("0:00:01")
Application.SendKeys "~"
End Sub
Code chạy nhưng dòng
Application.SendKeys "%P"
Không thấy bật PrintPreview
Các bác giúp em với

Nếu không cần bí mật thì tôi tò mò muốn biết, ứng dụng kia thế nào, tên nó là gì, tôi có không.

Sunbinsuzin · 13/12/18

batman1 đã viết:
Nếu không cần bí mật thì tôi tò mò muốn biết, ứng dụng kia thế nào, tên nó là gì, tôi có không.

Ứng dụng đó là Bar Tender (in mã vạch)

Bài đã được tự động gộp: 13/12/18

befaint đã viết:
Cho những thứ là code, là công thức vào chỗ chuyên chứa nó. Thấy người ta làm được thì mình cố làm cho giống vậy.

View attachment 209337

"Ko" là ứng dụng gì?

"Ko" hoạt động rồi thì hỏi làm gì nữa?

Nó hoạt động nhưng hình như nó ko sendkeys tổ hợp phím được ko biết là có cách nào khác để gọi lệnh in của ứng dụng này ko?
Ứng dung in mã vạch Bar Tender

TUTRUNGHIEU · 13/12/18

TUTRUNGHIEU đã viết:
Em chào các Admin và các anh chị!
Em không biết đăng bài vào đây có đúng chuyên mục không, có gì sai mong anh chị thông cảm giúp đỡ em ạ!
Em có 1 file Đơn hàng cần dùng vba để tìm lọc dữ liệu của 2 hoặc nhiều sheet về 1 sheet theo như các yêu cầu có ghi chú trong file đính kèm. Em mới biết sơ xài về VBA nên mong các anh chị giúp đỡ ạ!

Hic hic có bác nào help em với ạ!

Bài đã được tự động gộp: 13/12/18

TUTRUNGHIEU đã viết:
Hic hic có bác nào help em với ạ!

Hay là em đăng vào chưa đúng chuyên mục thì các bác chỉ giúp để em đăng lại ạ

Bài đã được tự động gộp: 13/12/18

TUTRUNGHIEU đã viết:
Hic hic có bác nào help em với ạ!

Hay là em đăng vào chưa đúng chuyên mục thì các bác chỉ giúp để em đăng lại ạ

blu3c4ndy · 13/12/18

Chào mọi người.
Em muốn thêm 1 cột STT ngay ở đầu, thì code không chạy được nữa.
Em không biết mình phải chỉnh chỗ nào để nếu chèn thêm cột vẫn không ảnh hưởng.
Mong cả nhà giúp đỡ.
Em có để file đính kèm ở dưới ạ.
Trân trọng.

Sub HienNgay()
On Error Resume Next
Application.ScreenUpdating = False
Dim Sh As Worksheet
Set Sh = Sheet1
n = Sh.Range("A65000").End(xlUp).Row
Sh.Range("A1:Q" & n).Copy Destination:=Sh.Range("AA1")
For i = n To 3 Step -1
If Format(Sh.Range("AM" & i), "dd/mm") = Format(Date, "dd/mm") And Sh.Range("AQ" & i) = "" Then
'
Else
Sh.Range("AA" & i & ":AQ" & i).Delete Shift:=xlUp
End If
Next
Sh.Columns("AE:AQ").Delete
Sh.Columns("AC:AC").Delete
ActiveWorkbook.Names.Add Name:="Danhsach", RefersToR1C1:= _
"=OFFSET(Sheet1!R3C27,,,COUNTA(Sheet1!R3C27:R500C27),4)"
Application.ScreenUpdating = True
End Sub

tranchautrungduong · 13/12/18

Gửi ACE GPE

Nhờ thêm code bên dưới giúp ạ!

Mã:

Private Sub cmdEdit_Click()



If Me!txtSTT.Value = "" Then

      

    MsgBox "Kh«ng cã d÷ liÖu ®Ó söa", , " Th«ng b¸o": Exit Sub

End If

Dim suanhaplieu As Long

Const TD As String = "cha nhËp d÷ liÖu!"

 

If Me!cbTinhTrang.Text = "" Then

    Msg = "T×nh tr¹ng"

ElseIf Me!txtKhachHang.Text = "" Then

    Msg = "Kh¸ch hµng"

ElseIf Me!txtVHC.Text = "" Then

    Msg = "VHC"

ElseIf Me!txtBOOK.Text = "" Then

    Msg = "Sè BOOKING"

ElseIf Me!txtGioCutOff.Text = "" Then

    Msg = "Giê Cut off"

ElseIf Me!txtngayCutOff.Text = "" Then

    Msg = "Ngµy Cut off"

ElseIf Me!cbNhaXe.Text = "" Then

    Msg = "Nhµ xe"

ElseIf Me!txtHangTau.Text = "" Then

    Msg = "H·ng tµu"

ElseIf Me!cbcangha.Text = "" Then

    Msg = "C¶ng h¹"

ElseIf Me!txtTauChuyen.Text = "" Then

    Msg = "tµu chuyÕn"

ElseIf Me!cbTuan.Text = "" Then

    Msg = "Tuan"

End If

If Msg <> "" Then

    MsgBox Msg & TD:                       Exit Sub

End If



Dim Rws As Long

Dim Rng As Range, sRng As Range

With TONGHOP

    Rws = .[A2].CurrentRegion.Rows.Count

    Set Rng = .[A2].Resize(Rws)

    Set sRng = Rng.Find(Me!txtSTT.Value, , xlValues, xlWhole)

    If Not sRng Is Nothing Then

  

    Rws = sRng.Row

    .Cells(Rws, "B").Value = Me!cbTuan.Text

    .Cells(Rws, "C").Value = Me!cbTinhTrang.Text

    .Cells(Rws, "D").Value = Me!txtKhachHang.Text

    .Cells(Rws, "E").Value = Me!txtVHC.Text

    .Cells(Rws, "F").Value = Me!txtBOOK.Text

    .Cells(Rws, "G").Value = Me!txtSoCont.Text

    .Cells(Rws, "H").Value = Me!txtDL.Text

    .Cells(Rws, "I").Value = Me!txtNW.Text

    .Cells(Rws, "J").Value = Me!txtngaydongcont.Text

    .Cells(Rws, "K").Value = Me!txtGioCutOff.Text

    .Cells(Rws, "L").Value = Me!txtngayCutOff.Text

    .Cells(Rws, "M").Value = Me!cbNhaXe.Text

    .Cells(Rws, "N").Value = Me!txtHangTau.Text

    .Cells(Rws, "O").Value = Me!cbcangha.Text

    .Cells(Rws, "P").Value = Me!txtTauChuyen.Text

    .Cells(Rws, "Q").Value = Me!txtETD.Text

    '.Cells(Rws, "P").Value = Me!txtETD.Text

    '.Cells(Rws, "P").Value = Me!txtETD.Text

    '.Cells(Rws, "P").Value = Me!txtETD.Text

    '.Cells(Rws, "P").Value = Me!txtETD.Text

    .Cells(Rws, "V").Value = Me!txtghichu.Text

    .Cells(Rws, "W").Value = Me!txtDienGiai.Text

    End If

End With

   MsgBox "Söa xong!", , " Th«ng b¸o"



End Sub

code này tìm ngay STT đó và ghi dè dữ liệu lên ngay dòng tìm đc, bây giờ mình muốn nó chèn thêm dòng bên dưới dòng tìm đc và dữ liệu sẽ đc ghi ngay dòng vùa chèn đó!

Cảm ơn ạ!

HeSanbi · 13/12/18

Sunbinsuzin đã viết:
Ứng dụng đó là Bar Tender (in mã vạch)

Bài đã được tự động gộp: 13/12/18

Nó hoạt động nhưng hình như nó ko sendkeys tổ hợp phím được ko biết là có cách nào khác để gọi lệnh in của ứng dụng này ko?
Ứng dung in mã vạch Bar Tender

Lập trình Python.

HeSanbi · 13/12/18

Sunbinsuzin đã viết:
Em cần gửi lệnh in tới cửa sổ ứng dụng khác thông qua VBA. Code em viết
Sub Text()
AppActivate("Filetext")
Application.Wait Now + TimeValue("0:00:01")
Application.SendKeys "%P"
Application.Wait Now + TimeValue("0:00:01")
Application.SendKeys "~"
End Sub
Code chạy nhưng dòng
Application.SendKeys "%P"
Không thấy bật PrintPreview
Các bác giúp em với

Phải hiểu Code nó như thế nào thì mới biết nó có Hoạt động không:
1.AppActivate (<Tiêu đề>): Tìm kiếm Tiêu đề ứng dụng đang hoạt động nếu đúng các ký tự tính từ trước ra sau.
nếu tìm thấy 2 ứng dụng trở lên thì sẽ Chọn ưu tiên
2. Sendkeys: Con trỏ chuột đang đứng ở ứng dụng nào thì Lệnh Sendkeys sẽ gửi key đến ứng dụng đó.
Tiêu đề ứng dụng bao gồm: tên Ứng dụng + / Tên tệp đang mở +/ một tiêu đề.
Làm sao AppActivate hiểu "Filetext" là Ứng dụng của bạn được đây

TUTRUNGHIEU · 13/12/18

TUTRUNGHIEU đã viết:
Hic hic có bác nào help em với ạ!

Bài đã được tự động gộp: 13/12/18

Hay là em đăng vào chưa đúng chuyên mục thì các bác chỉ giúp để em đăng lại ạ

Bài đã được tự động gộp: 13/12/18

Hay là em đăng vào chưa đúng chuyên mục thì các bác chỉ giúp để em đăng lại ạ

Anh chị ơi! Em có đăng đúng chuyên mục ko ạ? Có ai giúp dùm em với!

SA_DQ · 13/12/18

TUTRUNGHIEU đã viết:
Anh chị ơi! Em có đăng đúng chuyên mục ko ạ? Có ai giúp dùm em với!

Không xem đươc file của bạn, thật tiếc.

snow25 · 13/12/18

SA_DQ đã viết:
Không xem đươc file của bạn, thật tiếc.

Của em xem được nhưng rất khó hiểu.

befaint · 13/12/18

Sunbinsuzin đã viết:
ko sendkeys

"ko" là ứng dụng gì?

Sunbinsuzin đã viết:
ko biết

"ko" là phần mềm gì?

Sunbinsuzin đã viết:
này ko

"ko" là ứng dụng gì? là phần mềm gì?

batman1 · 13/12/18

Sunbinsuzin đã viết:
Ứng dụng đó là Bar Tender (in mã vạch)

Nó hoạt động nhưng hình như nó ko sendkeys tổ hợp phím được ko biết là có cách nào khác để gọi lệnh in của ứng dụng này ko?
Ứng dung in mã vạch Bar Tender

Bạn không nên viết tắt.

Tôi hiểu là bạn đã có Bar Tender mở và có dữ liệu. Vào một thời điểm thích hợp bạn muốn kích hoạt lệnh in.

1. Bạn đã kích hoạt Bar Tender như thế nào? Bạn có thể cho xem code kích hoạt đó không?

2. Bạn có chắc chắn là sau khi chạy dòng AppActivate("Filetext") thì Bar Tender là Active không? Căn cứ vào đâu bạn có chắc chắn đó?

3. Tôi không có Bar Tender nên không biết mặt mũi thế nào. Nếu SendKeys không được thì có thể sẽ phải tìm cách khác.

Bar Tender có ribbon như Excel, Word hay có menu như notepad? Nếu có menu như notepad thì Print nó ở mục menu chính thứ mấy tính từ trái qua phải, và trong mục menu chính đó nó ở mục menu con thứ mấy? Tốt nhất là bạn click vào menu chính có chứa Print để nó mở ra rồi chụp màn hình cho tôi xem. Trong trường hợp menu như notepad ta sẽ tìm cách kích hoạt Print bằng code.

tam888 · 13/12/18

batman1 đã viết:
Bạn không nên viết tắt.

Tôi hiểu là bạn đã có Bar Tender mở và có dữ liệu. Vào một thời điểm thích hợp bạn muốn kích hoạt lệnh in.

1. Bạn đã kích hoạt Bar Tender như thế nào? Bạn có thể cho xem code kích hoạt đó không?

2. Bạn có chắc chắn là sau khi chạy dòng AppActivate("Filetext") thì Bar Tender là Active không? Căn cứ vào đâu bạn có chắc chắn đó?

3. Tôi không có Bar Tender nên không biết mặt mũi thế nào. Nếu SendKeys không được thì có thể sẽ phải tìm cách khác.

Bar Tender có ribbon như Excel, Word hay có menu như notepad? Nếu có menu như notepad thì Print nó ở mục menu chính thứ mấy tính từ trái qua phải, và trong mục menu chính đó nó ở mục menu con thứ mấy? Tốt nhất là bạn click vào menu chính có chứa Print để nó mở ra rồi chụp màn hình cho tôi xem. Trong trường hợp menu như notepad ta sẽ tìm cách kích hoạt Print bằng code.

Chắc nó là cái này
https://www.seagullscientific.com/label-software/barcode-label-design-and-printing/

Tôi thì nghĩ , người dùng nên chịu khó bấm in đi, sao tự động với VBA có nhanh hơn không, số lượng in nhiều không?

TUTRUNGHIEU · 13/12/18

befaint đã viết:
"ko" là ứng dụng gì?

"ko" là phần mềm gì?

"ko" là ứng dụng gì? là phần mềm gì?

Mình k hiểu ý bạn. File đó chỉ là theo dõi kiểu nhập xuất thôi ạ. Mình muốn dùng vba để cho nhanh gọn và chính xác.

Bài đã được tự động gộp: 13/12/18

SA_DQ đã viết:
Không xem đươc file của bạn, thật tiếc.

Em gửi lại anh xem giúp em ạ. Thank you

befaint · 13/12/18

TUTRUNGHIEU đã viết:
Mình k hiểu ý bạn.

Một: Mình không trích dẫn, không trả lời bài của bạn.

Hai: "k" là ai? "k" làm gì?

Sunbinsuzin · 13/12/18

HeSanbi đã viết:
Phải hiểu Code nó như thế nào thì mới biết nó có Hoạt động không:
1.AppActivate (<Tiêu đề>): Tìm kiếm Tiêu đề ứng dụng đang hoạt động nếu đúng các ký tự tính từ trước ra sau.
nếu tìm thấy 2 ứng dụng trở lên thì sẽ Chọn ưu tiên
2. Sendkeys: Con trỏ chuột đang đứng ở ứng dụng nào thì Lệnh Sendkeys sẽ gửi key đến ứng dụng đó.
Tiêu đề ứng dụng bao gồm: tên Ứng dụng + / Tên tệp đang mở +/ một tiêu đề.
Làm sao AppActivate hiểu "Filetext" là Ứng dụng của bạn được đây

Vì %P trong ứng dụng đó ko được nên em đã thử %P = tay sau đó chạy code thì nó vẫn ~ được.
Em đã thử Code với 1 file Text, %P nó cũng ko PrintPreview nhưng nếu
Application.SendKeys "123456789"
Thì lại chuyền được.
-> Hình như khi chuyền tổ hợp phím qua ứng dụng khác thì vba ko chuyền được theo cách thông thường.
Ko biết là ngoài cách này bác nào có cách chuyền khác ko ?
Em viết vba trong FILE excel.

batman1 · 14/12/18

Tôi nhắc lại

2. Bạn có chắc chắn là sau khi chạy dòng AppActivate("Filetext") thì Bar Tender là Active không?
Căn cứ vào đâu bạn có chắc chắn đó?

Tôi nghĩ "Filetext" chỉ là ví dụ, vậy thực thế nó là thế nào?
Vd. nếu bạn mở "lay so cuoi.xls" thì trên thanh tiêu đề của Excel không phải có "lay so cuoi.xls" mà là "lay so cuoi.xls - Microsoft Excel". Cũng có thể là "lay so cuoi.xls [Compatibility Mode] - Microsoft Excel"

Ở chỗ "Filetext" bạn phải nhập đúng những gì nhìn thấy trên thanh tiêu đề của Bar Tender. Biết đâu nó còn có cả dấu cách trắng thừa. Tự thử thôi.

Sunbinsuzin đã viết:
Vì %P trong ứng dụng đó ko được nên em đã thử %P = tay sau đó chạy code thì nó vẫn ~ được.

Bạn có chắc Print là Alt + P chứ không phải Ctrl + P?

Tôi mở Delphi 5, Notepad hay Firefox thì Print đều là Ctrl + P. Trong khi bạn viết thì Print lại là Alt + P

Khi bạn thao tác bằng tay thì bạn nhấn Alt + P?

Tôi hỏi vì thấy bạn viết %P

Sunbinsuzin · 14/12/18

batman1 đã viết:
Tôi nhắc lại

Tôi nghĩ "Filetext" chỉ là ví dụ, vậy thực thế nó là thế nào?
Vd. nếu bạn mở "lay so cuoi.xls" thì trên thanh tiêu đề của Excel không phải có "lay so cuoi.xls" mà là "lay so cuoi.xls - Microsoft Excel". Cũng có thể là "lay so cuoi.xls [Compatibility Mode] - Microsoft Excel"

Ở chỗ "Filetext" bạn phải nhập đúng những gì nhìn thấy trên thanh tiêu đề của Bar Tender. Biết đâu nó còn có cả dấu cách trắng thừa. Tự thử thôi.

Bạn có chắc Print là Alt + P chứ không phải Ctrl + P?

Tôi mở Delphi 5, Notepad hay Firefox thì Print đều là Ctrl + P. Trong khi bạn viết thì Print lại là Alt + P

Khi bạn thao tác bằng tay thì bạn nhấn Alt + P?

Tôi hỏi vì thấy bạn viết %P

I sorry
Code em viết ko đúng.
Thay vì ^P em lại viết %P
Thank các bác nhiều ạ

Sunbinsuzin · 14/12/18

Sunbinsuzin đã viết:
I sorry
Code em viết ko đúng.
Thay vì ^P em lại viết %P
Thank các bác nhiều ạ

Em đã Text thành công rồi. Thank các bác.
Nhưng mà phải là ^p chứ ^P thì cũng ko mở lệnh in được

batman1 · 14/12/18

Sunbinsuzin đã viết:
Nhưng mà phải là ^p chứ ^P thì cũng ko mở lệnh in được

Mấu chốt là Ctrl + ... chứ không phải là Alt + ... như bạn tưởng.

Còn chuyện viết Ctrl + P là tôi viết chuẩn đấy bạn ạ. Bạn vào các menu thì sẽ thấy: Ctrl + P: print, Ctrl + A, Ctrl + H, Ctrl + F, Ctrl + V, Ctrl + C ... chứ người ta không viết Ctrl + p: print, Ctrl + a, Ctrl + h, Ctrl + f, Ctrl + v, Ctrl + c ... bạn ạ.

Viết thế nhưng luôn phải hiểu là chỉ nhấn phím p, a, h, f, v, c. Còn khi phải nhấn chữ hoa thì bao giờ người ta cũng viết Ctrl + Shift + ... bạn ạ.

VetMini · 14/12/18

batman1 đã viết:
Mấu chốt là Ctrl + ... chứ không phải là Alt + ... như bạn tưởng.
Còn chuyện viết Ctrl + P là tôi viết chuẩn đấy bạn ạ. ....

Cái tội hay tự chế cách viết tắt. Dần rồi quen, muốn tắt kiểu nào thì tắt, và nghĩ rằng máy có bổn phận phải hiểu.

noinhodayvoi20_10 · 14/12/18

Chào mọi người.
E đang có làm một file quản lý mã hàng theo kho. đang demo đơn giản như file đính kèm.
nhờ mọi người giúp, vd e muốn tìm kiếm một mã hàng.
e di chuyển đến từng kệ và dùng phương thức Find rồi hiển thị nó bằng Msgbox
Tuy nhiên, giả sử mã hàng nằm ở nhiều chỗ và mỗi khi nó di chuyển qua một Sheet thì msgbox lại hiển thị 1 lần.
Có cách nào để nó chạy hết 1 lúc và thông báo tổng thể 1 lần trên msgbox hoặc phương thức hiển thị gì đó khác không ạ.
Xin cám ơn mn nhiều.!

Sunbinsuzin · 14/12/18

VetMini đã viết:
Cái tội hay tự chế cách viết tắt. Dần rồi quen, muốn tắt kiểu nào thì tắt, và nghĩ rằng máy có bổn phận phải hiểu.

hí lúc đầu cái dòng này là % {Tab} để chuyển qua ứng dụng khác nhưng vì nó ko hoạt động nên em chuyển qua dùng AppActivate rồi sửa lại nó thành {Tab} thành P để gọi PrintPreview mà quên mất cái % ^_^

SA_DQ · 14/12/18

Có cách nào để nó chạy hết 1 lúc và thông báo tổng thể 1 lần trên msgbox hoặc phương thức hiển thị gì đó khác không ạ.

Thấy bạn đã có Form; vậy ta nên cho nó hiện lên ListBox hay bao nhiêu!
Nếu bạn không đủ lực, sáng mai mình sẽ giúp!
Các tên trang tính nên là Kho_01, Kho_02,. . . . . Kho_11,. . .
(Thậm chí có thể chỉ là: K01, K02, . . . . ,K11,. . . )

noinhodayvoi20_10 · 14/12/18

SA_DQ đã viết:
Thấy bạn đã có Form; vậy ta nên cho nó hiện lên ListBox hay bao nhiêu!
Nếu bạn không đủ lực, sáng mai mình sẽ giúp!
Các tên trang tính nên là Kho_01, Kho_02,. . . . . Kho_11,. . .
(Thậm chí có thể chỉ là: K01, K02, . . . . ,K11,. . . )

Dạ. Nhờ bác ngày mai bớt chút tgian giúp với ạ.
Còn tên các trang tính do e đặt nó theo biến i, nên có số 0 phía trước như K01 thì k biết ntn nên để đại nó K1 hoặc KHO_SO1 cho nó dễ

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

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

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

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

Thành viên mới

File đính kèm

Thành viên tiêu biểu

Thành viên mới

Cạo Rồi Khỏi Gội

Thành viên tiêu biểu

Thành viên mới

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

Thành viên mới

/(hông là gì!

/(hông là gì!

Thành viên mới

Thành viên mới

/(hông là gì!

Thành viên mới

RILY

File đính kèm

Thành viên tiêu biểu

RILY

Thành viên tiêu biểu

RILY

Thành viên tiêu biểu

RILY

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

/(hông là gì!

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

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

Thành viên mới

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

Cạo Rồi Khỏi Gội

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

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

Thành viên mới

GPE là ngôi nhà thứ 2 của tôi!!!

Thành viên mới

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

Thành viên mới

/(hông là gì!

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

/(hông là gì!

Thành viên mới

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

Thành viên mới

Thành viên mới

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

Thành viên mới

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

Thành viên mới

Thành viên mới

Cạo Rồi Khỏi Gội

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

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

File đính kèm

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

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

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

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

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

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

File đính kèm

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

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

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

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

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

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

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

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

File đính kèm

Thành viên gắn bó

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

Thành viên gắn bó

File đính kèm