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

HieuCD · 24/1/19

buiquangthuan đã viết:
Nhờ các thầy cô rút ngẵn đoạn code giúp em được không ạ

Mã:

Sub Boimau()
  Dim Ws As Worksheet, TenSheet As String
  TenSheet = "#UU#YE#YG#YH#YJ#YN#YQ#YP#YR#YS#YT#QQ#NN#PP#VV#SS#TT#RR#"
  For Each Ws In Worksheets
    If InStr(1, TenSheet, "#" & Ws.Name & "#") > 0 Then
      With Ws.Range("N11:O38").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
      End With
    End If
  Next Ws
End Sub

BuiQuangThuan · 24/1/19

Cám ơn các thầy cô ạ

BuiQuangThuan · 25/1/19

Sub XuatPDF()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
FileName = "ThisWorkbook & Name.pdf"
Quality = xlQualityStandard
IncludeDocProperties = True
IgnorePrintAreas = False
End Sub

Nhờ các thầy cô sửa giúp em đoạn code trên với ạ. Em muốn xuất tất cả sheet trong cùng 1 file. nhưng cái code trên nó lại chỉ xuất cái sheet hiện hành.
Nếu em muốn xuất PDF mà nó lưu vào khu vực mình muốn thì thêm code như nào ạ

befaint · 25/1/19

buiquangthuan đã viết:
Nhờ các thầy cô sửa giúp em đoạn code trên với ạ. Em muốn xuất tất cả sheet trong cùng 1 file. nhưng cái code trên nó lại chỉ xuất cái sheet hiện hành.
Nếu em muốn xuất PDF mà nó lưu vào khu vực mình muốn thì thêm code như nào ạ

PHP:

Sub Main()
    Const thumuc_gioidanh As String = "D:\Gioi danh"
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible = xlSheetVisible Then
            Luu_PDF ws, thumuc_gioidanh
        End If
    Next ws
End Sub

Sub Luu_PDF(ByVal ws As Worksheet, ByVal Noi_luu As String)
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Noi_luu & "\" & ws.Name & ".pdf"
End Sub

BuiQuangThuan · 25/1/19

ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Noi_luu & "\" & ws.Name & ".pdf"

nó báo lỗi ở dòng này ạ

befaint · 25/1/19

buiquangthuan đã viết:
nó báo lỗi ở dòng này ạ

Thì kệ nó đi bạn. Lỗi thì không tạo ra được file *.pdf >> không giải quyết được công việc >> Mệt người.

BuiQuangThuan · 25/1/19

befaint đã viết:
Thì kệ nó đi bạn. Lỗi thì không tạo ra được file *.pdf >> không giải quyết được công việc >> Mệt người.

Hihi. Dù Sao thì cung cám ơn ạ.

guitarnguyen1989 · 26/1/19

Nhờ mọi người giải thích dùm em ý nghĩa đoạn code bên dưới , qua trọng các dòng em đánh số .
code lồng nhiều hàm if quá ko hiểu nổi !!!

Mã:

Sub fifoNL()
  Dim nhapArr(), xuatArr(), Res()
  Dim I As Long, n As Long, sRow As Long
  Dim sNhap As Double, sXuat As Double, dXuat As Date
  Dim Ma As String, tmp As String
  With Sheets("DATANL")
    I = .Range("A" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    nhapArr = .Range("A3:D" & I).Value
    I = .Range("F" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    xuatArr = .Range("F3:H" & I).Value
    sRow = UBound(xuatArr)
1    ReDim Res(1 To sRow, 1 To 1)
  End With
  For I = 1 To sRow
    dXuat = xuatArr(I, 1): Ma = xuatArr(I, 2): sXuat = xuatArr(I, 3)
2     tmp = ""
    If Len(Ma) > 0 And sXuat > 0 Then
      For n = 1 To UBound(nhapArr)
        If nhapArr(n, 1) > dXuat Then Exit For
        If nhapArr(n, 2) = Ma Then
          sNhap = nhapArr(n, 3)
          If sNhap > 0 Then
            If sNhap >= sXuat Then
3              Res(I, 1) = tmp & nhapArr(n, 4)
4              If Len(tmp) > 0 Then Res(I, 1) = Res(I, 1) & "(" & sXuat & ")"
              nhapArr(n, 3) = sNhap - sXuat
              sXuat = 0
              Exit For
            Else
5              tmp = tmp & nhapArr(n, 4) & "(" & sNhap & "); "
              nhapArr(n, 3) = 0
              sXuat = sXuat - sNhap
            End If
          End If
        End If
      Next n
6      If sXuat > 0 Then Res(I, 1) = tmp & "Thieu(" & sXuat & ")"
    End If
  Next I
7  Sheets("DATANL").Range("I3").Resize(sRow) = Res
End Sub

CHAOQUAY · 27/1/19

guitarnguyen1989 đã viết:

Nhờ mọi người giải thích dùm em ý nghĩa đoạn code bên dưới , qua trọng các dòng em đánh số .
code lồng nhiều hàm if quá ko hiểu nổi !!!

Mã:

Sub fifoNL()
  Dim nhapArr(), xuatArr(), Res()
  Dim I As Long, n As Long, sRow As Long
  Dim sNhap As Double, sXuat As Double, dXuat As Date
  Dim Ma As String, tmp As String
  With Sheets("DATANL")
    I = .Range("A" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    nhapArr = .Range("A3:D" & I).Value
    I = .Range("F" & Rows.Count).End(xlUp).Row
    If I < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
    xuatArr = .Range("F3:H" & I).Value
    sRow = UBound(xuatArr)
1    ReDim Res(1 To sRow, 1 To 1)
  End With
  For I = 1 To sRow
    dXuat = xuatArr(I, 1): Ma = xuatArr(I, 2): sXuat = xuatArr(I, 3)
2     tmp = ""
    If Len(Ma) > 0 And sXuat > 0 Then
      For n = 1 To UBound(nhapArr)
        If nhapArr(n, 1) > dXuat Then Exit For
        If nhapArr(n, 2) = Ma Then
          sNhap = nhapArr(n, 3)
          If sNhap > 0 Then
            If sNhap >= sXuat Then
3              Res(I, 1) = tmp & nhapArr(n, 4)
4              If Len(tmp) > 0 Then Res(I, 1) = Res(I, 1) & "(" & sXuat & ")"
              nhapArr(n, 3) = sNhap - sXuat
              sXuat = 0
              Exit For
            Else
5              tmp = tmp & nhapArr(n, 4) & "(" & sNhap & "); "
              nhapArr(n, 3) = 0
              sXuat = sXuat - sNhap
            End If
          End If
        End If
      Next n
6      If sXuat > 0 Then Res(I, 1) = tmp & "Thieu(" & sXuat & ")"
    End If
  Next I
7  Sheets("DATANL").Range("I3").Resize(sRow) = Res
End Sub

Nếu muốn rõ ràng thì bạn nên gửi kèm theo file chứa code lên cho nhanh

VetMini · 27/1/19

Đọc code này thấy sặc mùi sì tin GPE.
Lấy ở thớt nào thì chịu khó cho luôn đường dẫn, bà con khỏi mất công tìm hiểu.
(ví dụ có những chỗ code dở hay sai, không thấy ngữ cảnh làm sao biết)

NghiaKieu · 30/1/19

Em mới học VBA mà tìm và thử mãi vẫn chưa làm được chọn ô cuối cùng của mảng vừa chọn. Nhờ các bác giúp đỡ với ạ.
Trân trọng cảm ơn!

Mã:

Sub Chon_o_cuoi()
'
    Sheets("Sheet1").range("mang1").Select
'    Cần code tiếp theo để đưa chuột về ô cuối cùng của mảng "mang1"

End Sub

SA_DQ · 30/1/19

naturooo đã viết:
Em mới học VBA mà tìm và thử mãi vẫn chưa làm được chọn ô cuối cùng của mảng vừa chọn. Nhờ các bác giúp đỡ với ạ.
Trân trọng cảm ơn!

PHP:

Sub Chon_O_Cuoi()
    Sheets("Sheet1").Range("mang1").Select
    With Selection
        If .Columns.Count = 1 Then
            .Offset()(.Rows.Count).Select
        Else
            .Offset()(.Cells.Count).Select
        End If
        MsgBox Selection.Address
    End With
End Sub

HieuCD · 30/1/19

naturooo đã viết:
Em mới học VBA mà tìm và thử mãi vẫn chưa làm được chọn ô cuối cùng của mảng vừa chọn. Nhờ các bác giúp đỡ với ạ.
Trân trọng cảm ơn!

Mã:

Sub Chon_o_cuoi()
  Sheets("Sheet1").Range("mang1").Select
  Selection(Selection.Rows.Count, Selection.Columns.Count).Select
End Sub

SA_DQ · 30/1/19

HieuCD đã viết:
Mã:

Sub Chon_o_cuoi() ' . . . . ' End Sub

PHP:

Sub Chon_O_Cuoi()
 '  Range1 = Union(Range("A2:B3"), [C1: D9])        '
    Sheets("Sheet1").Range("Range1").Select
    Selection(Selection.Rows.Count, Selection.Columns.Count).Select
    MsgBox Selection.Address
End Sub

HieuCD · 30/1/19

SA_DQ đã viết:

PHP:

Sub Chon_O_Cuoi()
'  Range1 = Union(Range("A2:B3"), [C1: D9])        '
    Sheets("Sheet1").Range("Range1").Select
    Selection(Selection.Rows.Count, Selection.Columns.Count).Select
    MsgBox Selection.Address
End Sub

Vấn đề là thế nào là ô cuối: ' Range1 = Union(Range("A2:A13"), [C1: D9])
Dùng vòng Do While để tính ô cuối

NghiaKieu · 31/1/19

HieuCD đã viết:
Mã:

Sub Chon_o_cuoi() Sheets("Sheet1").Range("mang1").Select Selection(Selection.Rows.Count, Selection.Columns.Count).Select End Sub

Em cảm ơn bác ạ. Code rất đúng ý em ạ.

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

SA_DQ đã viết:

PHP:

Sub Chon_O_Cuoi()
    Sheets("Sheet1").Range("mang1").Select
    With Selection
        If .Columns.Count = 1 Then
            .Offset()(.Rows.Count).Select
        Else
            .Offset()(.Cells.Count).Select
        End If
        MsgBox Selection.Address
    End With
End Sub

Em cảm ơn bác ạ. Code rất đúng ý em ạ!

Lequocvan · 7/2/19

Cho em hỏi tại sao với code sau:

Mã:

Sub ThemNgayNghiLe2()
    Dim Parts() As String
    Dim Default
    Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
    On Error GoTo NoText
    Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",")
    Range("A15:A30").Select
    With Selection
        .ClearContents
        .NumberFormat = "dd/mm/yyyy"
    End With
    With Range("A15").Resize(1 + UBound(Parts))
        .Cells = Application.Transpose(Parts)
    End With
NoText:
End Sub

Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox thì khi ra sheet nó lại thành kiểu mm/dd/yyyy.
Có cách nào nhập trên inputbox dạng dd/mm/yyyy, ..., cách nhau dấu phẩy thì vào A15 của sheet theo kiểu dd/mm/yyyy ah?

batman1 · 7/2/19

Lequocvan đã viết:
Cho em hỏi tại sao với code sau:

Mã:

Sub ThemNgayNghiLe2() Dim Parts() As String Dim Default Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019" On Error GoTo NoText Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",") Range("A15:A30").Select With Selection .ClearContents .NumberFormat = "dd/mm/yyyy" End With With Range("A15").Resize(1 + UBound(Parts)) .Cells = Application.Transpose(Parts) End With NoText: End Sub

Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox thì khi ra sheet nó lại thành kiểu mm/dd/yyyy.
Có cách nào nhập trên inputbox dạng dd/mm/yyyy, ..., cách nhau dấu phẩy thì vào A15 của sheet theo kiểu dd/mm/yyyy ah?

Nhìn

Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
...
Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",")

thì là bạn đang hướng dẫn người ta nhập theo dạng mm/dd/yyyy chứ đâu phải như bây giờ bạn viết là

Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox

Vấn đề khác: khi bạn nhập tay trên sheet ngày tháng chuẩn thì sẽ hiển thị là mm/dd/yyyy hay dd/mm/yyyy. Nói cách khác, thiết lập trong CP là thế nào? Đừng bắt là dd/mm/yyyy hay mm/dd/yyyy. Chỉ nên bắt đúng theo thiết lập trong CP. Còn nó là cái này hay cái kia thì do CP quyết định.

Lequocvan · 7/2/19

Tại em khó diễn đạt quá. Với code:

Mã:

Sub ThemNgayNghiLe3()
    Dim Parts() As String
    Dim Default
    Default = "31/01/2019,04/02/2019,05/02/2019,06/02/2019,07/02/2019,08/02/2019"
    On Error GoTo NoText
    Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY", Default, 10000, 1000), ", ", ","), ",")
    Range("A15:A30").Select
    With Selection
        .ClearContents
        .NumberFormat = "dd/mm/yyyy"
    End With
    With Range("A15").Resize(1 + UBound(Parts))
        .Cells = Application.Transpose(Parts)
    End With
NoText:
End Sub

Thì với 31/01/2019 thì nó dạng text, còn lại thì dạng dd/mm/yyyy nhưng lại hiển thị kiểu mm/dd/yyyy ah

Còn khi vào nhập dữ liệu vào box kiểu tháng trước ngày sau thì kết quả ở sheet lại chuẩn kiểu dd/mm/yyyy. Mà em thì muốn kiểu VN.

batman1 · 7/2/19

Thôi tôi cũng không đi sâu vào vấn đề nữa.
Bạn thử sửa thành

Mã:

.NumberFormat = "m/d/yyyy"

thì kết quả test sẽ thế nào?

VetMini · 7/2/19

Khi dùng code, người ta luôn luôn tránh tình trạng ngày tháng không thống nhất.
Trước khi ghi dữ liệu, luôn luôn đưa nó về dạng chuẩn. Bạn có hai cách:
1. dùng hàm dateserials để đổi chuỗi thành dạng số - chịu khó tìm, trên diễn đàn có nhiều rồi.
2. dùng dạng chuẩn của CSDL, tức là "yyyy/mm/dd". Khi Excel gặp dữ liệu loại này, nó tự động đổi thành ngày đúng như mong muốn.

Mã:

Sub ThemNgayNghiLe2()
    Dim Parts() As String
    Dim Default
    Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
    On Error GoTo NoText
    Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAYS (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",")
    Range("A15:A30").Select
    With Selection
        .ClearContents
        .NumberFormat = "dd/mm/yyyy"
    End With
    For Default = LBound(Parts) To UBound(Parts)
        Parts(Default) = UniversalDate(Parts(Default), "US") ' nếu nhập dạng dd/mm/yyyy thì dùng tham "EU"
    Next Default
    Range("A15").Resize(1 + UBound(Parts)).Cells = Application.Transpose(Parts)
NoText:
End Sub

Function UniversalDate(ByVal d As String, Optional inTyp As String = "US") As String
' function to change date string from dd/mm/yyyy (inTyp="EU"), or mm/dd/yyyy (inTyp="US") to yyyy/mm/dd
Dim x() As String
x = Split(d, "/")
If Len(x(2)) < 4 Then x(2) = CStr(2000 + Val(x2)) ' normalise year
If UCase(inTyp) = "US" Then
UniversalDate = x(2) & "/" & x(0) & "/" & x(1)
Else
UniversalDate = x(2) & "/" & x(1) & "/" & x(0)
End If
End Function

(tôi chỉ mách cho cách giải quyết dữ liệu ngày tháng thôi. Code của bạn có hiệu quả hay không là chuyện khác)

batman1 · 7/2/19

Nếu tôi không lầm thì bạn nên nhập ở dạng "mm/dd/yyyy" như bạn đang làm bây giờ và

Mã:

.NumberFormat = "m/d/yyyy"

Lúc đó mang sang máy nào cũng chuẩn, chả cần thêm code gì cả.

Tôi trình bầy với 2 thiết lập Ba Lan và Việt Nam ở máy tôi. Bạn chạy ở máy bạn xem thế nào.

Khi bạn đã hỏi và có người trả lời thì nên thông báo lại là vấn đề có được giải quyết hay không. "Lặng lẽ" chuồn là không nên.

Nếu trên máy bạn lại khác thì thông báo để tôi biết nhé.

VetMini · 7/2/19

batman1 đã viết:
Nếu tôi không lầm thì bạn nên nhập ở dạng "mm/dd/yyyy" như bạn đang làm bây giờ và

Mã:

.NumberFormat = "m/d/yyyy"

Lúc đó mang sang máy nào cũng chuẩn, chả cần thêm code gì cả.
...

Điểm này tôi đồng ý với bác. VBA luôn luôn mặc định biến đổi ngày theo dạng của Mẽo. Vì vậy nhập ở dạng mm/dd/yyy thì máy nào cũng ra được ngày như nhau cả.

Tôi nghĩ người hỏi bài bị rối (confused) ở chỗ 31/01/2019 vẫn ra giống như 01/31/2019. Cho nên mới phải đem lên đây hỏi.
Câu trả lời là: tuy VBA mặc định dạng mm/dd/yyyy nhưng nếu gặp tháng lớn hơn 12 thì nó tự động hiểu như dạng dd/mm/yyyy

Bác bảo immediate
? #01/31/2019#, #31/01/2019#
sẽ thấy nó in ra cả hai đều là ngày 31 tháng giêng

batman1 · 7/2/19

VetMini đã viết:
Bác bảo immediate
? #01/31/2019#, #31/01/2019#
sẽ thấy nó in ra cả hai đều là ngày 31 tháng giêng

Thì thế tôi mới nói là phải nhập ở dạng "mm/dd/yyyy". Nếu muốn nhập 31 tháng Một năm 2019 thì phải nhập 01/31/2019 - dạng "mm/dd/yyyy" như yêu cầu, chứ không nên nhập 31/01/2019 - dạng "dd/mm/yyyy" không như yêu cầu.

Mà người hỏi cũng nhập

"01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"

chứ có nhập

"31/01/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"

đâu.

VetMini · 7/2/19

batman1 đã viết:
Thì thế tôi mới nói là phải nhập ở dạng "mm/dd/yyyy". Nếu muốn nhập 31 tháng Một năm 2019 thì phải nhập 01/31/2019 - dạng "mm/dd/yyyy" như yêu cầu, chứ không nên nhập 31/01/2019 - dạng "dd/mm/yyyy" không như yêu cầu.

Mà người hỏi cũng nhập

"01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"

chứ có nhập

"31/01/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"

đâu.

Ở bài #1873 người hỏi bị lủng củng kiểu nhập.

Lequocvan đã viết:
Tại em khó diễn đạt quá. Với code:

Mã:

Sub ThemNgayNghiLe3() Dim Parts() As String Dim Default Default = "31/01/2019,04/02/2019,05/02/2019,06/02/2019,07/02/2019,08/02/2019" On Error GoTo NoText Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY", Default, 10000, 1000), ", ", ","), ",") Range("A15:A30").Select With Selection .ClearContents .NumberFormat = "dd/mm/yyyy" End With With Range("A15").Resize(1 + UBound(Parts)) .Cells = Application.Transpose(Parts) End With NoText: End Sub

Thì với 31/01/2019 thì nó dạng text, còn lại thì dạng dd/mm/yyyy nhưng lại hiển thị kiểu mm/dd/yyyy ah

Còn khi vào nhập dữ liệu vào box kiểu tháng trước ngày sau thì kết quả ở sheet lại chuẩn kiểu dd/mm/yyyy. Mà em thì muốn kiểu VN.
View attachment 211992

.
31/01/2019 ở dạng text là vì hàm Transpose không tự động chuyển từ dd/mm sang mm/dd được. Và bảng tính không nhận nó là ngày.
04/02/2019 được dịch ra là ngày 2 tháng tư, lên bảng tính bạn định dạng thành ra 02/04/2019
Nếu bạn đặt ở ô B16, hàm =A16+1 thì sẽ thấy là 03/04/2019

batman1 · 7/2/19

VetMini đã viết:
Ở bài #1873 người hỏi bị lủng củng kiểu nhập.

Thì thế bài #1872 tôi mới thắc mắc - vì lủng củng ngay từ bài #1871 rồi - vì tôi không hiểu.

Nhìn
Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
...
Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (mm/dd/yyyy)", Default, 10000, 1000), ", ", ","), ",")

Nhấp chuột vào đây để mở rộng...

thì là bạn đang hướng dẫn người ta nhập theo dạng mm/dd/yyyy chứ đâu phải như bây giờ bạn viết là

Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox

Nhấp chuột vào đây để mở rộng...

Rõ ràng hướng dẫn cho người khác ở trên trời, à nhầm, ở tiêu đề InputBox, là phải nhập dạng mm/dd/yyyy - List of HOLIDAY (mm/dd/yyyy), và cả ở dưới đất, à nhầm, ở Default, là phải nhập dạng mm/dd/yyyy - "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019". Nhưng tới khi mình nhập thì lại nhập dạng dd/mm/yyyy - Khi nhập giá trị ngày tháng theo kiểu dd/mm/yyyy vào inputbox.

Tuy nhiên do tác giả không giải thích cho tôi sự mâu thuẫn trong cách hành sử của mình nên tôi bỏ qua

Thôi tôi cũng không đi sâu vào vấn đề nữa.

Tôi đề nghị mm/dd/yyyy + .NumberFormat = "m/d/yyyy" là để kết quả luôn hiển theo đúng như thiết lập trên máy hiện hành. Tức hiển thị sao cho đúng như người sử dụng hàng ngày vẫn quen. Bởi nếu dùng code

Mã:

Sub ThemNgayNghiLe2()
    Dim Parts() As String
    Dim Default
    Default = "01/31/2019,02/04/2019,02/05/2019,02/06/2019,02/07/2019,02/08/2019"
    On Error GoTo NoText
    Parts = Split(Replace(InputBox("Enter the values separated by commas", "List of HOLIDAY (" & Format(Date, "Short Date") & ")", Default, 10000, 1000), ", ", ","), ",")
    Range("A15:A30").Select
    With Selection
        .ClearContents
        .NumberFormat = "dd/mm/yyyy"
    End With
    With Range("A15").Resize(1 + UBound(Parts))
        .Cells = Application.Transpose(Parts)
    End With
NoText:
End Sub

thì trên máy tôi kết quả đúng là ngày tháng (định dạng Custom: dd-mm-yyyy) nhưng là
31-01-2019
04-02-2019
05-02-2019
06-02-2019
07-02-2019
08-02-2019

Nó làm cho người dùng hơi bị bất ngờ tuy người ta vẫn hiểu, và không đúng chuẩn Ba Lan. Chuẩn là
2019-01-31
2019-02-04
2019-02-05
2019-02-06
2019-02-07
2019-02-08

Chính vì thế mà tôi yêu sách là phải làm sao trả về đúng ngày tháng. Còn chuyện nó có dạng thư thế nào trên máy hiện hành thì không nên can thiệp. Cứ cứng nhắc là phải nhìn thấy 31/01/2019 là không được. Phải làm sao để anh Việt nhìn thấy 31/01/2019 nhưng cũng tập tin đó, code đó thì anh Ba Lan phải nhìn thấy 2019-01-31, anh Anh cũng phải nhìn thấy như mình hàng ngày vẫn thấy.

Mọi code viết chỉ để cố tình định dạng kết quả theo một dạng cứng nhắc theo tôi là không nên dùng. Chỉ phải trả kết quả đúng là ngày tháng. Còn dạng như thế nào thì để Excel tự xác định dựa trên thiết lập trong CP của máy hiện hành

Lequocvan · 8/2/19

Dạ em cảm ơn ah, tại tối muộn mà sáng lại đi trực nên chưa reply and like các Thầy ah! em đang làm cái bảng cho bên kho quỹ tính công bốc xếp, chấm công..... Em đang test các kiểu. em sẽ báo lại sau khi hoàn chỉnh ah!

NghiaKieu · 15/2/19

Mã:

Sub Test()
'
    Dim r1, r2, c1, c2 As Long
    Sheets("Sheet1").Select
    Range("mang1").Select
    Selection(1, 1).Select
    r1 = Application.Selection.Row
    c1 = Application.Selection.Column
    Sheets("Sheet2").Select
    Range("mang2").Select
    Selection(1, 1).Select
    r2 = Application.Selection.Row - r1
    c2 = Application.Selection.Column - c1
    Sheets("Sheet1").Range("mang1").FormulaR1C1 = "=Data!R[r2]C[c2]"
'
End Sub

Các anh cho em hỏi tại dòng code 14: "=Data!R[r2]C[c2]" thì có cách nào đưa biến r2, c2 vào công thức muốn chèn không ạ. Em đưa vào bị lỗi không chạy được.
Mục đích code VBA để chèn công thức từ mang1 ở Sheet 1 lấy dữ liệu tương ứng từ mang2 ở Sheet2 trong khi mảng 2 không cố định vị trí.
Trân trọng cảm ơn!

CHAOQUAY · 15/2/19

naturooo đã viết:
Mã:

Sub Test() ' Dim r1, r2, c1, c2 As Long Sheets("Sheet1").Select Range("mang1").Select Selection(1, 1).Select r1 = Application.Selection.Row c1 = Application.Selection.Column Sheets("Sheet2").Select Range("mang2").Select Selection(1, 1).Select r2 = Application.Selection.Row - r1 c2 = Application.Selection.Column - c1 Sheets("Sheet1").Range("mang1").FormulaR1C1 = "=Data!R[r2]C[c2]" ' End Sub

Các anh cho em hỏi tại dòng code 14: "=Data!R[r2]C[c2]" thì có cách nào đưa biến r2, c2 vào công thức muốn chèn không ạ. Em đưa vào bị lỗi không chạy được.
Mục đích code VBA để chèn công thức từ mang1 ở Sheet 1 lấy dữ liệu tương ứng từ mang2 ở Sheet2 trong khi mảng 2 không cố định vị trí.
Trân trọng cảm ơn!

"=Data!R[r2]C[c2]" là 1 chuỗi, bạn thu sua lại the này xem sao
"=Data!R[" & r2 & "]C[" & c2 & "]"

NghiaKieu · 15/2/19

CHAOQUAY đã viết:
"=Data!R[r2]C[c2]" là 1 chuỗi, bạn thu sua lại the này xem sao
"=Data!R[" & r2 & "]C[" & c2 & "]"

Không được bạn ơi. Báo lỗi cú pháp (Syntax error) bạn ạ.

CHAOQUAY · 15/2/19

naturooo đã viết:
Không được bạn ơi. Báo lỗi cú pháp (Syntax error) bạn ạ.

Bạn gưi file lên dể sửa trong file cho dễ.

NghiaKieu · 15/2/19

CHAOQUAY đã viết:
Bạn gưi file lên dể sửa trong file cho dễ.

Bạn xem giúp m nhé:

CHAOQUAY · 15/2/19

naturooo đã viết:
Bạn xem giúp m nhé:

Mã:

'Sheets("Sheet1").Range("mang1").FormulaR1C1 = "=Sheet2!R["&r2&"]C["&c2&"]"
Sheets("Sheet1").Range("mang1").FormulaR1C1 = "=Sheet2!R[" & r2 & "]C[" & c2 & "]"

Bạn thay dòng trên bằng dòng dưới là ok. Lỗi là do thiếu dấu phân cách

NghiaKieu · 15/2/19

CHAOQUAY đã viết:
Mã:

'Sheets("Sheet1").Range("mang1").FormulaR1C1 = "=Sheet2!R["&r2&"]C["&c2&"]" Sheets("Sheet1").Range("mang1").FormulaR1C1 = "=Sheet2!R[" & r2 & "]C[" & c2 & "]"

Bạn thay dòng trên bằng dòng dưới là ok. Lỗi là do thiếu dấu phân cách

Hay quá, mình đã làm được rồi, cảm ơn bạn nhiều nhé!

BuiQuangThuan · 16/2/19

Sub test()
Dim i As Integer
For i = 2 To 36 Step 5
For j = 8 To 38 Step 5
Range("G" & i).Value = "='[03.2019 CROWN.xlsm]Oshidashi Crown'!K$" & j
Next j
Next i
End Sub

nhờ các thầy giúp em xem đoạn code này sai chỗ nào với ạ
Đơn thuần em muốn ở ô:
G2 = K8 của sheet khác
G7= K13

HeSanbi · 16/2/19

buiquangthuan đã viết:
nhờ các thầy giúp em xem đoạn code này sai chỗ nào với ạ
Đơn thuần em muốn ở ô:
G2 = K8 của sheet khác
G7= K13

Bạn dùng 2 vòng lặp ở tình huấn này là không đúng

Mã:

Sub test()
Dim i As Integer
For i = 2 To 36 Step 5
Range("G" & i).Value = "='[03.2019 CROWN.xlsm]Oshidashi Crown'!K$" & i + 6
Next i
End Sub

BuiQuangThuan · 16/2/19

HeSanbi đã viết:
Bạn dùng 2 vòng lặp ở tình huấn này là không đúng

Mã:

Sub test() Dim i As Integer For i = 2 To 36 Step 5 Range("G" & i).Value = "='[03.2019 CROWN.xlsm]Oshidashi Crown'!K$" & i + 6 Next i End Sub

nếu em muốn cho nó chạy từ cột G đến cột AK thì phải thêm vòng lặp thế nào ạ

vuvanthe2000 · 16/2/19

Các bác cho em hỏi có lệnh như này thì viết như nào ạ?
Nếu textbox.text = "" thì không không thực hiện chạy sub ( không thực nhập dữ liệu từ button "nhập liệu")

BuiQuangThuan · 16/2/19

HeSanbi đã viết:
Bạn dùng 2 vòng lặp ở tình huấn này là không đúng

Mã:

Sub test() Dim i As Integer For i = 2 To 36 Step 5 Range("G" & i).Value = "='[03.2019 CROWN.xlsm]Oshidashi Crown'!K$" & i + 6 Next i End Sub

Anh ạ. Nó vẫn chưa ra kết quả đúng.
Chẳng hạn em muốn ngược lại là:
K9=G3
k14=G8
K19= G13
thì phải làm thế nào ạ. hay tạo 1 cột xong lấy range theo số mình muốn ạ
Lý do có cái này là do em muốn link dữ liệu từ 2 file sang cho nhau ạ

HeSanbi · 16/2/19

buiquangthuan đã viết:
Anh ạ. Nó vẫn chưa ra kết quả đúng.
Chẳng hạn em muốn ngược lại là:
K9=G3
k14=G8
K19= G13
thì phải làm thế nào ạ. hay tạo 1 cột xong lấy range theo số mình muốn ạ
Lý do có cái này là do em muốn link dữ liệu từ 2 file sang cho nhau ạ

Bạn có thể áp dụng code sau, tuy nhiên đã chạy code rồi thì không ai đi làm phương pháp thủ công nữa cả

PHP:

Sub test_CopyData()
  CopyData [k9], [g3], -6, "Oshidashi Crown", "03.2019 CROWN.xlsm", 36, 5, True, False
End Sub
  Function CopyData(Rng1 As Range, _
  Rng2 As Range, _
  istep%, _
  Optional ByVal worksheetStr$ = "Oshidashi Crown", _
  Optional ByVal workbookStr$, _
  Optional ByVal stopLoop% = 36, _
  Optional ByVal stepLoop% = 5, _
  Optional ByVal RowAbsolute As Boolean = True, Optional ByVal ColumnAbsolute As Boolean = False)
    Dim i%
    For i = Rng1.Row To stopLoop Step stepLoop
      Cells(i, Rng1.Column).Formula = "=" & IIf(workbookStr = "", "", "[" & workbookStr & "]") & worksheetStr & "!" & _
      Cells(i + istep, Rng2.Column).Address(RowAbsolute, ColumnAbsolute)
    Next i
  End Function

BuiQuangThuan · 16/2/19

HeSanbi đã viết:

Bạn có thể áp dụng code sau, tuy nhiên đã chạy code rồi thì không ai đi làm phương pháp thủ công nữa cả

PHP:

Sub test_CopyData()
  CopyData [k9], [g3], -6, "Oshidashi Crown", "03.2019 CROWN.xlsm", 36, 5, True, False
End Sub
  Function CopyData(Rng1 As Range, _
  Rng2 As Range, _
  istep%, _
  Optional ByVal worksheetStr$ = "Oshidashi Crown", _
  Optional ByVal workbookStr$, _
  Optional ByVal stopLoop% = 36, _
  Optional ByVal stepLoop% = 5, _
  Optional ByVal RowAbsolute As Boolean = True, Optional ByVal ColumnAbsolute As Boolean = False)
    Dim i%
    For i = Rng1.Row To stopLoop Step stepLoop
      Cells(i, Rng1.Column).Value = "=" & IIf(workbookStr = "", "", "[" & workbookStr & "]") & worksheetStr & "!" & _
      Cells(i + istep, Rng2.Column).Address(RowAbsolute, ColumnAbsolute)
    Next i
  End Function

Cám ơn anh ạ. Tại em mới học. Nên mới thủ công thế ạ. Nhưng file đính kèm là 2 file em muốn links dữ liệu cho nhau. Do 2 file nằm trên 2 chỗ khác nhau. Nếu có thể phiền anh viết đoạn code cập nhật giúp ạ. Và hướng dẫn luôn cho em để các tháng tiếp theo em có thể tự làm ạ.
em cám ơn trước

HeSanbi · 16/2/19

buiquangthuan đã viết:
Cám ơn anh ạ. Tại em mới học. Nên mới thủ công thế ạ. Nhưng file đính kèm là 2 file em muốn links dữ liệu cho nhau. Do 2 file nằm trên 2 chỗ khác nhau. Nếu có thể phiền anh viết đoạn code cập nhật giúp ạ. Và hướng dẫn luôn cho em để các tháng tiếp theo em có thể tự làm ạ.
em cám ơn trước

Bạn đăng bài mới, hỏi đúng chủ đề sẽ có người hỗ trợ bạn

BuiQuangThuan · 16/2/19

HeSanbi đã viết:
Bạn đăng bài mới, hỏi đúng chủ đề sẽ có người hỗ trợ bạn

Hì. Thôi em cám ơn anh nhé. Dùng thủ công xíu cũng được. Chứ đăng bài mới. Lỡ sai box. Lại bị mắng. Để em nghiên cứu dần dần ạ

BuiQuangThuan · 18/2/19

Sub GOMU()
Dim i As Integer
Dim j As Integer
For i = 2 To 251
For j = 5 To 35
If Cells(i, 4) = "KHSX" Then Cells(i, j) = "'[KH Thang 03.2019 GOMU + SHINSHEN.xlsm]gomu'!" & j & "$" & Cells(i, 39)
Next j
Next i
End Sub

Chào các thầy ạ. các thầy cho em hỏi 1 chút ạ.
Em đang khai báo j là cột. mà giờ em muốn khi j=1 thì nó trả về =cột A
j=2 thì trả về giá trị bằng cột B thì phải dùng hàm gì ạ

snow25 · 18/2/19

buiquangthuan đã viết:
Chào các thầy ạ. các thầy cho em hỏi 1 chút ạ.
Em đang khai báo j là cột. mà giờ em muốn khi j=1 thì nó trả về =cột A
j=2 thì trả về giá trị bằng cột B thì phải dùng hàm gì ạ

Bạn hỏi kỳ vậy.Mặc định j=1 là cột A rồi mà.Cần gì hàm nữa.Mà bạn gửi file lên xem.

BuiQuangThuan · 18/2/19

snow25 đã viết:
Bạn hỏi kỳ vậy.Mặc định j=1 là cột A rồi mà.Cần gì hàm nữa.Mà bạn gửi file lên xem.

Xin lỗi anh chị ạ. Tại em nói chưa vỡ lẽ. Cái đoạn code trên kia. Khi em để j chạy từ 5 đến 35. Khi chạy đoạn code nó hiện ra số luôn. Mà mục đích cuối cùng của em muốn là hiện ra tên cột ạ

snow25 · 18/2/19

buiquangthuan đã viết:
Xin lỗi anh chị ạ. Tại em nói chưa vỡ lẽ. Cái đoạn code trên kia. Khi em để j chạy từ 5 đến 35. Khi chạy đoạn code nó hiện ra số luôn. Mà mục đích cuối cùng của em muốn là hiện ra tên cột ạ

Vậy bạn tham khảo bài này nhé.
https://www.giaiphapexcel.com/diend...column-chuyển-chỉ-số-cột-thành-chữ-cái.14990/

VetMini · 18/2/19

buiquangthuan đã viết:
Xin lỗi anh chị ạ. Tại em nói chưa vỡ lẽ. Cái đoạn code trên kia. Khi em để j chạy từ 5 đến 35. Khi chạy đoạn code nó hiện ra số luôn. Mà mục đích cuối cùng của em muốn là hiện ra tên cột ạ

Cột:
tenCot = Split(Cells(i, j).Addess(), "$")(1)

SA_DQ · 18/2/19

Khi thử Code thì ta đơn giản những thứ khác đi, sao cho nó chạy đúng cái đã; Bạn thử với cái này, khi có trang 'GPE'

PHP:

Sub Test()
Dim I As Integer, J As Integer
For I = 2 To 36 Step 5
    For J = 8 To 13 Step 5
        Range("G" & I).Value = "=GPE!K$" & CStr(J)
        MsgBox Range("G" & I).Value, , Range("G" & I).Address
    Next J
Next I
End Sub

BuiQuangThuan · 18/2/19

VetMini đã viết:
Cột:
tenCot = Split(Cells(i, j).Addess(), "$")(1)

em đưa vào đoạn code trên không được ạ

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

SA_DQ đã viết:
Khi thử Code thì ta đơn giản những thứ khác đi, sao cho nó chạy đúng cái đã; Bạn thử với cái này, khi có trang 'GPE'

PHP:

Sub Test() Dim I As Integer, J As Integer For I = 2 To 36 Step 5 For J = 8 To 13 Step 5 Range("G" & I).Value = "=GPE!K$" & CStr(J) MsgBox Range("G" & I).Value, , Range("G" & I).Address Next J Next I End Sub

Thầy ơi.

khi có trang 'GPE'

là thế nào ạ

SA_DQ · 18/2/19

Thì bạn tạo ra trang tính có tên là vậy; Trên trang đó nhập những số liệu khác nhau vào các ô trước khi chạy macro.

saugio · 21/2/19

Chào cả nhà,
Mình đang cần như sau:
Mình có 10 sheets (hoặc hơn). Mình muốn đánh số cho sheet thứ 4 trở đi đến hết, còn các sheets trước sheet mình đặt button thì không đánh số thì code như thế nào? Nhờ các bạn tư vấn giúp.
Tks tất cả.

HeSanbi · 21/2/19

saugio đã viết:
Chào cả nhà,
Mình đang cần như sau:
Mình có 10 sheets (hoặc hơn). Mình muốn đánh số cho sheet thứ 4 trở đi đến hết, còn các sheets trước sheet mình đặt button thì không đánh số thì code như thế nào? Nhờ các bạn tư vấn giúp.
Tks tất cả.

Bạn thử code sau

PHP:

Sub OrderSheets()
    Dim i%, K%
    For i = 1 to Worksheets.Count
        If i > 3 Then K = K + 1: Worksheets(i).Name = K & ". " & Worksheets(i).Name
    Next
End Sub

snow25 · 21/2/19

HeSanbi đã viết:
Bạn thử code sau

PHP:

Sub OrderSheets() Dim i% For i = 1 to Worksheets.Count If i > 3 Then K = K + 1: Worksheets(i).Name = K & ". " & Worksheets(i).Name Next End Sub

Sao không cho i chạy từ 4 vậy ta.Mà dùng thêm biến k nữa làm gì.

HeSanbi · 21/2/19

snow25 đã viết:
Sao không cho i chạy từ 4 vậy ta.Mà dùng thêm biến k nữa làm gì.

Đánh nhanh thắng nhanh với vấn đề cơ bản, vấn đề khó mới nên bỏ nhiều chất xám để tư duy, và sáng tạo.
Code viết không suy nghĩ quá 0.01% của bộ não

saugio · 22/2/19

Ai da, cám ơn bạn nha. Mình đưa yêu cầu thiếu thông tí xíu!!!
Mình muốn đánh số thứ tự trang (page number) cho sheet thứ 4 trở đi đến hết chứ không phải số của sheet.

rockylk · 22/2/19

Chào cả nhà
Minh đang tập tành làm VBA, mình có tạo 1 userform (file đính kèm 2019-Test). Mình đang bị dừng lại ở chỗ tạo button OK để add new workbook, mình đã lên mạng tham khảo và có được dòng code để tạo workbook mới nhưng lại không thể copy hết 2 sheets từ file "BGmau.xls" (chỉ copy được sheet ChiTiet còn sheet BGgui thì lại không copy được) .Mong mọi người tham khảo và tư vấn giúp. Thanks all

A Đặng · 23/2/19

Dear All.!
Cho em hỏi : em thấy một số người viết sub dạng sau
“ sub ABC(ABC as long)”
Những sub vậy không chạy trực tiếp đc?
Vậy sub như vậy là sao ạ? Cám ơn

snow25 · 23/2/19

A Đặng đã viết:
Dear All.!
Cho em hỏi : em thấy một số người viết sub dạng sau
“ sub ABC(ABC as long)”
Những sub vậy không chạy trực tiếp đc?
Vậy sub như vậy là sao ạ? Cám ơn

Cái đấy thêm điều kiện đó ABC.Sub đấy là gọi ra dùng thôi.Nó vẫn chạy được với Code của bạn không liên quan đến ABC.

namtakz · 24/2/19

xin chào cả nhà, cho mình hỏi làm cách nào để tạo 2 group option như thế này vậy ạ ?

A Đặng · 24/2/19

namtakz đã viết:
View attachment 212643xin chào cả nhà, cho mình hỏi làm cách nào để tạo 2 group option như thế này vậy ạ ?

Chọn công cụ Frame trong toolbox nhé

namtakz · 24/2/19

A Đặng đã viết:
Chọn công cụ Frame trong toolbox nhé

cảm ơn nhé ^^

namtakz · 24/2/19

Mình có 2 thắc mắc về combobox:
-xóa một phần tử khỏi combobox
-kiểm tra một phần tử đã có trong combobox hay chưa
các cao nhân giúp với ạ

rockylk · 25/2/19

rockylk đã viết:
Chào cả nhà
Minh đang tập tành làm VBA, mình có tạo 1 userform (file đính kèm 2019-Test). Mình đang bị dừng lại ở chỗ tạo button OK để add new workbook, mình đã lên mạng tham khảo và có được dòng code để tạo workbook mới nhưng lại không thể copy hết 2 sheets từ file "BGmau.xls" (chỉ copy được sheet ChiTiet còn sheet BGgui thì lại không copy được) .Mong mọi người tham khảo và tư vấn giúp. Cảm ơn all

Nhờ mọi người giúp em với ah

hungpecc1 · 25/2/19

rockylk đã viết:
Nhờ mọi người giúp em với ah

1-không thấy file đính kèm
2-Với dạng bài kiểu này bạn có thể lập topic riêng để tiện theo dõi

rockylk · 25/2/19

hungpecc1 đã viết:
1-không thấy file đính kèm
2-Với dạng bài kiểu này bạn có thể lập topic riêng để tiện theo dõi

File đây ah. Em mới tham gia diễn đàn nên cũng chưa quen lắm ah.Thank anh

batman1 · 25/2/19

rockylk đã viết:
Nhờ mọi người giúp em với ah

Code của bạn sau khi copy sheet ChiTiet thì đóng tập tin BG mau.xls. Theo lôgíc thì phải sau khi thực hiện xong vòng lặp FOR để copy hết các sheet mới đóng tập tin. Tóm lại cần đưa dòng owb.Close False ra sau vòng lặp .
Tức sửa

Mã:

...
owb.Close False 'Đóng workbook nhung không th?c hi?n luu
  Next sh
...

thành

Mã:

...
Next sh
  owb.Close False 'Đóng workbook nhung không th?c hi?n luu
...

Ngoài ra xóa sFil = Dir vì nó chả làm gì cả.

Dòng sFil = Dir(sPath & "BG mau.xls") để làm gì? Vì có thực hiện thì cũng chỉ có sFil = "BG mau.xls".

Nếu bạn xóa dòng sFil = Dir(...) thì sửa

Mã:

Set owb = Workbooks.Open(sPath & sFil)

thành

Mã:

Set owb = Workbooks.Open(sPath & "BG mau.xls")

Tôi không viết lại code cho bạn. Tôi chỉ chỉ ra những chỗ sai trên tinh thần: "Học trên những lỗi đã mắc phải". Có thế mới nhớ lâu.

rockylk · 25/2/19

batman1 đã viết:
Code của bạn sau khi copy sheet ChiTiet thì đóng tập tin BG mau.xls. Theo lôgíc thì phải sau khi thực hiện xong vòng lặp FOR để copy hết các sheet mới đóng tập tin. Tóm lại cần đưa dòng owb.Close False ra sau vòng lặp .
Tức sửa

Mã:

... owb.Close False 'Đóng workbook nhung không th?c hi?n luu Next sh ...

thành

Mã:

... Next sh owb.Close False 'Đóng workbook nhung không th?c hi?n luu ...

Ngoài ra xóa sFil = Dir vì nó chả làm gì cả.

Dòng sFil = Dir(sPath & "BG mau.xls") để làm gì? Vì có thực hiện thì cũng chỉ có sFil = "BG mau.xls".

Nếu bạn xóa dòng sFil = Dir(...) thì sửa

Mã:

Set owb = Workbooks.Open(sPath & sFil)

thành

Mã:

Set owb = Workbooks.Open(sPath & "BG mau.xls")

Tôi không viết lại code cho bạn. Tôi chỉ chỉ ra những chỗ sai trên tinh thần: "Học trên những lỗi đã mắc phải". Có thế mới nhớ lâu.

Thank bác, đúng là chỉ có vậy mới nhớ như in luôn ^^

batman1 · 25/2/19

rockylk đã viết:
Thank bác, đúng là chỉ có vậy mới nhớ như in luôn ^^

Sau khi học các lỗi thì bạn có thể tham khảo một cách khác. Bạn không phải tự tạo tập tin mới, và sau đó không phải tự xóa các sheet không cần thiết.

Chú ý: Khi dùng ActiveSheet và ActiveWorkbook thì phải chắc chắn là ở thời điểm đang xét thì sheet nào, tập tin nào đang hoạt động.

Mã:

Private Sub btaddOK_Click()
Const sPath = "D:\Test VBA\"  'Đuong dan toi thu muc chua workbook dang dóng'
Dim k As Long
Dim A, B, C As String
Dim owb As Workbook
    A = ComboBox1.Value
    B = TextBox1.Value
    C = TextBox2.Value

    Application.ScreenUpdating = False
'    mo tap tin can sao chep
    Set owb = Workbooks.Open(sPath & "BG mau.xls")
'    copy sheet dau tien cua tap tin owb. Excel tu tao tap tin moi
    owb.Sheets(1).Copy
'    copy cac sheet con lai
    For k = 2 To owb.Sheets.Count
'        ActiveSheet la sheet vua copy cua tap tin moi vua duoc tao
        owb.Sheets(k).Copy ActiveSheet
    Next k
    owb.Close False
   
    Application.ScreenUpdating = True
   
'    Save New file '
    With ActiveWorkbook
        .SaveAs Filename:=sPath & A & "." & B & "." & C & ".xlsx"
        .Close
    End With
End Sub

rockylk · 25/2/19

batman1 đã viết:
Sau khi học các lỗi thì bạn có thể tham khảo một cách khác. Bạn không phải tự tạo tập tin mới, và sau đó không phải tự xóa các sheet không cần thiết.

Chú ý: Khi dùng ActiveSheet và ActiveWorkbook thì phải chắc chắn là ở thời điểm đang xét thì sheet nào, tập tin nào đang hoạt động.

Mã:

Private Sub btaddOK_Click() Const sPath = "D:\Test VBA\" 'Đuong dan toi thu muc chua workbook dang dóng' Dim k As Long Dim A, B, C As String Dim owb As Workbook A = ComboBox1.Value B = TextBox1.Value C = TextBox2.Value Application.ScreenUpdating = False ' mo tap tin can sao chep Set owb = Workbooks.Open(sPath & "BG mau.xls") ' copy sheet dau tien cua tap tin owb. Excel tu tao tap tin moi owb.Sheets(1).Copy ' copy cac sheet con lai For k = 2 To owb.Sheets.Count ' ActiveSheet la sheet vua copy cua tap tin moi vua duoc tao owb.Sheets(k).Copy ActiveSheet Next k owb.Close False Application.ScreenUpdating = True ' Save New file ' With ActiveWorkbook .SaveAs Filename:=sPath & A & "." & B & "." & C & ".xlsx" .Close End With End Sub

Thank bác, đây cũng là 1 cách hay, em sẽ ghi nhớ lại. Em vẫn muốn dùng For Each vì sau này trên file BGmau em sẽ còn tạo thêm nhiều sheet dữ liệu nữa ạ ^^. Sẵn đây bác có thể hưỡng dẫn thêm cho em về cách tạo nút button NEXT dc ko. Yêu cầu là: 1 báo giá (workbook vừa tạo từ btt OK) sẽ có nhiều hàng, code em viết thì chỉ lấy dữ liệu từ Form vào hàng thứ 2 thôi, nên giờ em muốn tạo thêm nút NEXT để add thêm dữ liệu vào các hàng tiếp theo. Đồng thời khi nhấn btt NEXT thì sẽ giữ lại nội dung của thẻ Khách Hàng và MĐH còn lại thì xóa trắng hết. Chân thành cảm ơn ạ

batman1 · 25/2/19

rockylk đã viết:
Thank bác, đây cũng là 1 cách hay, em sẽ ghi nhớ lại. Em vẫn muốn dùng For Each vì sau này trên file BGmau em sẽ còn tạo thêm nhiều sheet dữ liệu nữa ạ ^^.

Có lẽ bạn đọc code nhưng không hiểu. Tôi đã lường trước được tình huống này.

Tôi luôn coi tập tin chỉ là ví dụ, còn thực tế có thể khác, vì thế tôi thường cố gắng viết cho trường hợp tổng quát. Tôi hơi khác người là vậy.

Bạn để ý thì thấy tôi không đề nghị

Mã:

Sheets(Array("ChiTiet", "BGgui")).Copy

Vì code đó chỉ copy 2 sheet, và phải đúng tên là "ChiTiet" và "BGgui". Nếu thế thì sau này khi bạn thêm nhiều sheet thì code vẫn chỉ copy 2 sheet có tên y hệt như liệt kê. Thậm chí không thêm sheet nhưng bạn đổi tên 2 sheet kia thì code sẽ có lỗi.

Code mà tôi cho bạn tham khảo không bị phụ thuộc vào sự chỉnh sửa. Nó luôn copy tất cả các sheet hiện có với tên bất kỳ.

Dòng

Mã:

owb.Sheets(1).Copy

là copy sheet đầu tiên. Mỗi tập tin luôn có ít nhất 1 sheet nên dòng trên copy sheet đầu tiên

Còn

Mã:

For k = 2 To owb.Sheets.Count
'        ActiveSheet la sheet vua copy cua tap tin moi vua duoc tao
        owb.Sheets(k).Copy ActiveSheet
Next k

là copy lần lượt từ sheet thứ 2 cho đến sheet cuối cùng. Nếu tập tin hiện hành chỉ có 1 sheet thì 2 > owb.Sheets.Count nên vòng FOR sẽ không được thực hiện.

rockylk · 25/2/19

batman1 đã viết:
Có lẽ bạn đọc code nhưng không hiểu. Tôi đã lường trước được tình huống này.

Tôi luôn coi tập tin chỉ là ví dụ, còn thực tế có thể khác, vì thế tôi thường cố gắng viết cho trường hợp tổng quát. Tôi hơi khác người là vậy.

Bạn để ý thì thấy tôi không đề nghị

Mã:

Sheets(Array("ChiTiet", "BGgui")).Copy

Vì code đó chỉ copy 2 sheet, và phải đúng tên là "ChiTiet" và "BGgui". Nếu thế thì sau này khi bạn thêm nhiều sheet thì code vẫn chỉ copy 2 sheet có tên y hệt như liệt kê. Thậm chí không thêm sheet nhưng bạn đổi tên 2 sheet kia thì code sẽ có lỗi.

Code mà tôi cho bạn tham khảo không bị phụ thuộc vào sự chỉnh sửa. Nó luôn copy tất cả các sheet hiện có với tên bất kỳ.

Dòng

Mã:

owb.Sheets(1).Copy

là copy sheet đầu tiên. Mỗi tập tin luôn có ít nhất 1 sheet nên dòng trên copy sheet đầu tiên

Còn

Mã:

For k = 2 To owb.Sheets.Count ' ActiveSheet la sheet vua copy cua tap tin moi vua duoc tao owb.Sheets(k).Copy ActiveSheet Next k

là copy lần lượt từ sheet thứ 2 cho đến sheet cuối cùng. Nếu tập tin hiện hành chỉ có 1 sheet thì 2 > owb.Sheets.Count nên vòng FOR sẽ không được thực hiện.

Em như được đã thông kinh mạch rồi

). Thank nhìu ạ. Chỗ tạo btt NEXT có thể tư vấn thêm cho em được ko ạ

batman1 · 25/2/19

Bạn muốn người khác làm hộ thì phải viết cụ thể. Không thể viết chung chung được.

rockylk đã viết:
Sẵn đây bác có thể hưỡng dẫn thêm cho em về cách tạo nút button NEXT dc ko. Yêu cầu là: 1 báo giá (workbook vừa tạo từ btt OK) sẽ có nhiều hàng, code em viết thì chỉ lấy dữ liệu từ Form vào hàng thứ 2 thôi, nên giờ em muốn tạo thêm nút NEXT để add thêm dữ liệu vào các hàng tiếp theo. Đồng thời khi nhấn btt NEXT thì sẽ giữ lại nội dung của thẻ Khách Hàng và MĐH còn lại thì xóa trắng hết.

Hiện tại bạn đã viết code đâu? Nếu bạn đã viết mà code "chỉ lấy dữ liệu từ Form vào hàng thứ 2 thôi" thì tôi còn có cơ sở để đoán là bạn muốn sửa thế nào. Còn không thì bó tay.com.

Tóm lại thì khi nhấn NEXT thì code phải làm các bước cự thể nào. Phải liệt kê cụ thể và liệt kê hết. Tôi không chơi kểu nói chung chung, cụt lủn.

Khi nhấn NEXT thì code copy những gì, từ đâu (nếu từ Form thì từ các trường nào) , vào đâu (vào sheet nào của tập tin nào, dán vào dòng nào cột nào). Liệt kê cụ thể. Cho 1 ví dụ cụ thể.

Mà bạn nói là copy vào tập tin vừa tạo bởi OK? Tập tin đó bạn đã đóng khi thực hiện code của OK mà. Bây giờ code của NEXT mở lại tập tin vừa đóng? Thế thì trước đó tại sao lại đóng ?

rockylk · 25/2/19

batman1 đã viết:
Bạn muốn người khác làm hộ thì phải viết cụ thể. Không thể viết chung chung được.

Hiện tại bạn đã viết code đâu? Nếu bạn đã viết mà code "chỉ lấy dữ liệu từ Form vào hàng thứ 2 thôi" thì tôi còn có cơ sở để đoán là bạn muốn sửa thế nào. Còn không thì bó tay.com.

Tóm lại thì khi nhấn NEXT thì code phải làm các bước cự thể nào. Phải liệt kê cụ thể và liệt kê hết. Tôi không chơi kểu nói chung chung, cụt lủn.

Khi nhấn NEXT thì code copy những gì, từ đâu (nếu từ Form thì từ các trường nào) , vào đâu (vào sheet nào của tập tin nào, dán vào dòng nào cột nào). Liệt kê cụ thể. Cho 1 ví dụ cụ thể.

Mà bạn nói là copy vào tập tin vừa tạo bởi OK? Tập tin đó bạn đã đóng khi thực hiện code của OK mà. Bây giờ code của NEXT mở lại tập tin vừa đóng? Thế thì trước đó tại sao lại đóng ?

Code đây ạ
X.Worksheets(1).Range("H2").End(xlUp).Offset(1, 0).Value = KH.Text
X.Worksheets(1).Range("G2").End(xlUp).Offset(1, 0).Value = MDH.Text
X.Worksheets(1).Range("I2").End(xlUp).Offset(1, 0).Value = TH.Text
X.Worksheets(1).Range("J2").End(xlUp).Offset(1, 0).Value = VT.Text
X.Worksheets(1).Range("Y2").End(xlUp).Offset(1, 0).Value = NCC.Text
Khi nhấn NEXT thi những dữ liệu nhập trên Form sẽ nhập tiếp vào các dòng H3,G3,I2,... của sheet ChiTiet
Em đóng new workbook tại nút OK là vì sẽ có những báo giá chỉ có 1 dòng thôi

batman1 · 25/2/19

rockylk đã viết:
Code đây ạ
X.Worksheets(1).Range("H2").End(xlUp).Offset(1, 0).Value = KH.Text
X.Worksheets(1).Range("G2").End(xlUp).Offset(1, 0).Value = MDH.Text
X.Worksheets(1).Range("I2").End(xlUp).Offset(1, 0).Value = TH.Text
X.Worksheets(1).Range("J2").End(xlUp).Offset(1, 0).Value = VT.Text
X.Worksheets(1).Range("Y2").End(xlUp).Offset(1, 0).Value = NCC.Text
Khi nhấn NEXT thi những dữ liệu nhập trên Form sẽ nhập tiếp vào các dòng H3,G3,I2,... của sheet ChiTiet
Em đóng new workbook tại nút OK là vì sẽ có những báo giá chỉ có 1 dòng thôi

Tôi xóa bài này vì bạn hỏi 2 nơi. Sang "bên kia" mà chờ nhé.

rockylk · 26/2/19

batman1 đã viết:
Tôi xóa bài này vì bạn hỏi 2 nơi. Sang "bên kia" mà chờ nhé.

Bài bên này em đằn lên hỏi khoảng 3 4 ngày trước rồi mà ko thấy ai trả lời với có người bảo em nên tạo topic mới để dễ theo dõi nên em mới tạo thêm. Anh thông cảm dùm em nha. Rất cám ơn sự giúp đỡ nhiệt tình của anh. Anh qua bài bên kia giúp em tiếp tục nha. E test thử rồi mà nó báo lỗi, em gửi lại file anh kiểm tra lại dùm em nha

batman1 đã viết:
Tôi xóa bài này vì bạn hỏi 2 nơi. Sang "bên kia" mà chờ nhé.

nghiank09 · 26/2/19

Hi ae, nhờ anh em viết giùm mình đoạn code sau để lọc dữ liệu từ 1 bảng khoảng vài trăm nghìn dòng:
Cho i chạy từ 2 đến 1000000
Với từng i: Nếu ô Ai chứa ký tự dấu ngoặc trái "(" hoặc ô Hi có giá trị <0 hoặc ô Ji có giá trị khác #N/A thì xóa dữ liệu dòng i.Nếu không thỏa điều kiện trên thì sẽ xuống dòng tiếp theo.
Mình mới mày mò VBA, chỉ có thể ghi lại macro để dùng, chưa biết viết code. Nhờ ae giúp đỡ

kimmi268 · 26/2/19

Chào cả nhà,
Mình đang làm một số công việc cần trích xuất dữ liệu excel rất nhiều ra các biểu mẫu word. Mình có tìm hiểu trên mạng và lượm được 1 đoạn code theo video như sau. tuy nhiên khi mình chạy thử code chỉ tạo ra các biểu mấu mới chứ không điền dữ liệu vào được. công việc gấp và mình cũng chưa có kiến thức vba cơ bản, mong các bạn trong diễn đàn trợ giúp. Cảm ơn các bạn nhiều!
code:

Mã:

Sub bbntcv()
Dim num_of_cust As Long
Dim num_of_column As Long
Dim i As Long, j As Long
Dim template As Object
Dim t As Object

num_of_column = 14

num_of_cust = Sheet6.Cells(Rows.Count, "A").End(xlUp).Row - 1
With CreateObject("word.application")
.Visible = True

For i = 1 To num_of_cust
Set template = .documents.Open("C:\Users\NGHIALT\Desktop\New folder\BBNTCV.doc")
Set t = template.Content
For j = 1 To num_of_column
t.Find.Execute _
FindText:=Sheet6.Cells(1, j).Value, _
ReplaceWith:=Sheet6.Cells(i + 1, j).Value, _
Replace:=wdReplaceAll
Next
template.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & i & "-BBNTCV.doc"
Next
.Quit
End With
Set t = Nothing
Set template = Nothing

End Sub

batman1 · 26/2/19

kimmi268 đã viết:
Chào cả nhà,
Mình đang làm một số công việc cần trích xuất dữ liệu excel rất nhiều ra các biểu mẫu word. Mình có tìm hiểu trên mạng và lượm được 1 đoạn code theo video như sau. tuy nhiên khi mình chạy thử code chỉ tạo ra các biểu mấu mới chứ không điền dữ liệu vào được. công việc gấp và mình cũng chưa có kiến thức vba cơ bản, mong các bạn trong diễn đàn trợ giúp. Cảm ơn các bạn nhiều!
code:

Bạn đã vi phạm nội qui khi gửi 2 bài có cùng nội dung ở 2 nơi.

Hãy xóa bài trong chủ đề này, để lại 1 bài thôi.

batman1 · 26/2/19

rockylk đã viết:
Bài bên này em đằn lên hỏi khoảng 3 4 ngày trước rồi mà ko thấy ai trả lời với có người bảo em nên tạo topic mới để dễ theo dõi nên em mới tạo thêm. Anh thông cảm dùm em nha. Rất cám ơn sự giúp đỡ nhiệt tình của anh. Anh qua bài bên kia giúp em tiếp tục nha. E test thử rồi mà nó báo lỗi, em gửi lại file anh kiểm tra lại dùm em nha

Tôi tưởng tôi xóa kịp nhưng hóa ra bạn đã kịp copy bài của tôi.

Tôi gõ thiếu.
Sửa

Mã:

owb = sPath & A & "." & B & "." & C & ".xlsx"

thành

Mã:

owb_filename = sPath & A & "." & B & "." & C & ".xlsx"

Tức sửa owb thành owb_filename.

Do nút NEXT mở tập tin được tạo bởi nút OK nên thứ tự phải là click OK, sau đó mới click NEXT

rockylk · 26/2/19

batman1 đã viết:
Tôi tưởng tôi xóa kịp nhưng hóa ra bạn đã kịp copy bài của tôi.

Tôi gõ thiếu.
Sửa

Mã:

owb = sPath & A & "." & B & "." & C & ".xlsx"

thành

Mã:

owb_filename = sPath & A & "." & B & "." & C & ".xlsx"

Tức sửa owb thành owb_filename.

Do nút NEXT mở tập tin được tạo bởi nút OK nên thứ tự phải là click OK, sau đó mới click NEXT

Dạ bài post của bác gửi lên mail nên em mới có ạ . Thank ạ

kimmi268 · 27/2/19

batman1 đã viết:
Bạn đã vi phạm nội qui khi gửi 2 bài có cùng nội dung ở 2 nơi.

Hãy xóa bài trong chủ đề này, để lại 1 bài thôi.

mình muốn xóa topic ngoài kia nhưng k tìm đc nút xóa, mong mod xóa giúm topic. Thanks!

batman1 · 27/2/19

kimmi268 đã viết:
mình muốn xóa topic ngoài kia nhưng k tìm đc nút xóa, mong mod xóa giúm topic. Cảm ơn!

Thôi được, tôi liều vậy. Nếu người ta xóa trong chủ đề này thì coi như là tôi mất công.

Nguyên nhân thì nhìn thấy ngay thôi.

t.Find.Execute _

FindText:=Sheet6.Cells(1, j).Value, _

ReplaceWith:=Sheet6.Cells(i + 1, j).Value, _

Replace:=wdReplaceAll

wdReplaceAll là hằng số của Word. Nếu code chạy bên Word thì nó biết là wdReplaceAll = 2. Nhưng code chạy bên Excel nên nó không biết wdReplaceAll là gì, nên nó cho đấy là tên của biến, mà biến đó không được khai báo tường minh. Do không có thiết lập giá trị cho "biến" này nên nó có giá trị bằng 0. Khi đối tượng t.Find của Word thực hiện phương thức Execute thì nó gặp số 0 cho Replace. Mà 0 ở bên Word có ý nghĩa là wdReplaceNone (wdReplaceNone = 0), tức KhôngThaythế. Vì thế chả có chỗ nào được thay thế bằng giá trị từ Excel.

Tóm lại, sau dòng Sub bbntcv() thì phải thêm dòng

Mã:

Const wdReplaceAll = 2

Lúc này thì đã "điền dữ liệu vào được". Tuy nhiên có vài chỗ sẽ phải sửa:

1. Bên Excel có D1 = "[[shh]] ". Tức thừa dấu cách. Khi đổi sang Word thì thời gian "dính" với từ "ngày" ở sau nó.

2. shh và ehh khi sang Word sẽ không là dạng 7:00 mà là 0,291666... Vì thời gian, ngày tháng chẳng qua là số.

3. I2 = 0,155273368606702, và số thập phân này sẽ hiển thị Word, tức có vd.

Thực tế

0,155273368606702

Nếu là chưa có kiến thức vba cơ bản thì tại sao lại dùng VBA? Bạn biết trộn thư - mail merge không?

kimmi268 · 27/2/19

batman1 đã viết:
Thôi được, tôi liều vậy. Nếu người ta xóa trong chủ đề này thì coi như là tôi mất công.

Nguyên nhân thì nhìn thấy ngay thôi.

wdReplaceAll là hằng số của Word. Nếu code chạy bên Word thì nó biết là wdReplaceAll = 2. Nhưng code chạy bên Excel nên nó không biết wdReplaceAll là gì, nên nó cho đấy là tên của biến, mà biến đó không được khai báo tường minh. Do không có thiết lập giá trị cho "biến" này nên nó có giá trị bằng 0. Khi đối tượng t.Find của Word thực hiện phương thức Execute thì nó gặp số 0 cho Replace. Mà 0 ở bên Word có ý nghĩa là wdReplaceNone (wdReplaceNone = 0), tức KhôngThaythế. Vì thế chả có chỗ nào được thay thế bằng giá trị từ Excel.

Tóm lại, sau dòng Sub bbntcv() thì phải thêm dòng

Mã:

Const wdReplaceAll = 2

Lúc này thì đã "điền dữ liệu vào được". Tuy nhiên có vài chỗ sẽ phải sửa:

1. Bên Excel có D1 = "[[shh]] ". Tức thừa dấu cách. Khi đổi sang Word thì thời gian "dính" với từ "ngày" ở sau nó.

2. shh và ehh khi sang Word sẽ không là dạng 7:00 mà là 0,291666... Vì thời gian, ngày tháng chẳng qua là số.

3. I2 = 0,155273368606702, và số thập phân này sẽ hiển thị Word, tức có vd.

Thực tế

0,155273368606702

Nếu là chưa có kiến thức vba cơ bản thì tại sao lại dùng VBA? Bạn biết trộn thư - mail merge không?

Cảm ơn bạn, tối qua mày mò mình cũng đã chỉnh sửa để code có thể chạy tạm được rồi

Tuy nhiên mình cũng mạn phép muốn thắc mắc thêm thêm 1 số vấn đề mong được mod và các bạn giải đáp.
Do yêu cầu công việc mình cần xử lý 1 số lượng văn bản dạng này rất lớn trong thời gian ngắn. mình thấy phương pháp sử dụng vba sẽ hữu ích hơn nhiều và cũng muốn tìm hiểu thêm về vba nên mạn phép qua đây học hỏi cùng mọi người, mong mod thông cảm.
thứ nhất:
về vấn đề định dạng 7:00 thành 0,291666... mình đã xử lý bằng cách thay thế việc lấy giá trị .Value thành lấy văn bản .Text:

Mã:

FindText:=Sheet6.Cells(1, j).Text, _
ReplaceWith:=Sheet6.Cells(i + 1, j).Text,

thứ 2:
mình muốn tối ưu hóa code này thêm 1 chút, bằng việc có thể xuất file ra theo từng dòng (hoặc 1 vài dòng) mình muốn, không biết mod cũng như các bạn có thể giúp đỡ mình không. trân trọng!

batman1 · 27/2/19

kimmi268 đã viết:
mình muốn tối ưu hóa code này thêm 1 chút, bằng việc có thể xuất file ra theo từng dòng (hoặc 1 vài dòng) mình muốn, không biết mod cũng như các bạn có thể giúp đỡ mình không. trân trọng!

Tôi nghĩ là VBA làm được nhưng chỉ nói chung chung "từng dòng (hoặc 1 vài dòng)" thì không ai hiểu bạn muốn gì.

vanthinh3101 · 27/2/19

nghiank09 đã viết:
Hi ae, nhờ anh em viết giùm mình đoạn code sau để lọc dữ liệu từ 1 bảng khoảng vài trăm nghìn dòng:
Cho i chạy từ 2 đến 1000000
Với từng i: Nếu ô Ai chứa ký tự dấu ngoặc trái "(" hoặc ô Hi có giá trị <0 hoặc ô Ji có giá trị khác #N/A thì xóa dữ liệu dòng i.Nếu không thỏa điều kiện trên thì sẽ xuống dòng tiếp theo.
Mình mới mày mò VBA, chỉ có thể ghi lại macro để dùng, chưa biết viết code. Nhờ ae giúp đỡ

Nếu dữ liệu nhiều như vậy thì nên dùng ADO thì hơn?
Bạn đưa ít dữ liệu giả định (Template phải chuẩn) lên để mọi người giúp cho?

kimmi268 · 27/2/19

batman1 đã viết:
Tôi nghĩ là VBA làm được nhưng chỉ nói chung chung "từng dòng (hoặc 1 vài dòng)" thì không ai hiểu bạn muốn gì.

tức là code này giúp mình xuất ra tất cả các bản ghi (file word) cho 1 click, mỗi bản ghi tương ứng với 1 dòng dữ liệu mình có trong bảng excel. ý tưởng của mình là trong trường hợp mình chỉ muốn xuất 1 bản ghi tương ứng với dòng dữ liệu đầu tiên hoặc 3 bản ghi tương ứng với dòng dữ liệu 5,8,16 (giống như việc mình print all hay print page đó) thì có thể không? trân trọng!

batman1 · 27/2/19

kimmi268 đã viết:
tức là code này giúp mình xuất ra tất cả các bản ghi (file word) cho 1 click, mỗi bản ghi tương ứng với 1 dòng dữ liệu mình có trong bảng excel. ý tưởng của mình là trong trường hợp mình chỉ muốn xuất 1 bản ghi tương ứng với dòng dữ liệu đầu tiên hoặc 3 bản ghi tương ứng với dòng dữ liệu 5,8,16 (giống như việc mình print all hay print page đó) thì có thể không? trân trọng!

Tôi hiểu 5,8,16 là chỉ số dòng trên sheet của dòng dữ liệu cần lấy.

Thế 5,8,16 bạn nhập ở đâu? Hay là hiện InputBox để nhập?

Bạn quá kiệm lời. Bạn muốn người khác viết code cho cả 2 trường hợp? Vì nếu không người ta chỉ viết cho 1 trường hợp thì bạn sẽ nói là bạn muốn trường hợp 2 và người ta lại sửa?

Nếu vấn đề là của mình thì mình nên chăm hơn tất cả các người khác, bỏ công càng nhiều để những người sẽ giúp mình bỏ công ra càng ít.

Tôi làm cho cách 1: nhập 5,8,16 hoặc 5, 8, 16 vào NTCV!Q1 (tự sửa trong code nếu nhập chỗ khác), tập tin Excel và Word đặt trong cùng thư mục.

Mã:

Sub bbntcv()
Const wdReplaceAll = 2
    Dim dong
    Dim num_of_column As Long
    Dim k As Long, i As Long, j As Long
    Dim template As Object, t As Object

    num_of_column = 14
    
    With Sheet6.Range("Q1")
        If Trim(.Value) = "" Then Exit Sub
        dong = Split(Trim(.Value), ",")
    End With
    With CreateObject("word.application")
'        .Visible = True
        For i = 0 To UBound(dong)
            k = Trim(dong(i))
            Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                t.Find.Execute findtext:=Sheet6.Cells(1, j).Value, ReplaceWith:=Sheet6.Cells(k, j).Text, Replace:=wdReplaceAll
            Next j
            With template
                .SaveAs Filename:=ThisWorkbook.Path & "\" & i & "-BBNTCV.doc"
                .Close
            End With
        Next i
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
    
End Sub

kimmi268 · 27/2/19

batman1 đã viết:
Tôi hiểu 5,8,16 là chỉ số dòng trên sheet của dòng dữ liệu cần lấy.

Thế 5,8,16 bạn nhập ở đâu? Hay là hiện InputBox để nhập?

Bạn quá kiệm lời. Bạn muốn người khác viết code cho cả 2 trường hợp? Vì nếu không người ta chỉ viết cho 1 trường hợp thì bạn sẽ nói là bạn muốn trường hợp 2 và người ta lại sửa?

Nếu vấn đề là của mình thì mình nên chăm hơn tất cả các người khác, bỏ công càng nhiều để những người sẽ giúp mình bỏ công ra càng ít.

Tôi làm cho cách 1: nhập 5,8,16 hoặc 5, 8, 16 vào NTCV!Q1 (tự sửa trong code nếu nhập chỗ khác), tập tin Excel và Word đặt trong cùng thư mục.

Mã:

Sub bbntcv() Const wdReplaceAll = 2 Dim dong Dim num_of_column As Long Dim k As Long, i As Long, j As Long Dim template As Object, t As Object num_of_column = 14 With Sheet6.Range("Q1") If Trim(.Value) = "" Then Exit Sub dong = Split(Trim(.Value), ",") End With With CreateObject("word.application") ' .Visible = True For i = 0 To UBound(dong) k = Trim(dong(i)) Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc") Set t = template.Content For j = 1 To num_of_column t.Find.Execute findtext:=Sheet6.Cells(1, j).Value, ReplaceWith:=Sheet6.Cells(k, j).Text, Replace:=wdReplaceAll Next j With template .SaveAs Filename:=ThisWorkbook.Path & "\" & i & "-BBNTCV.doc" .Close End With Next i .Quit End With Set t = Nothing Set template = Nothing End Sub

Lời đầu tiên mình rất cảm ơn bạn đã nhiệt tình giúp đỡ mình, do kiến thức còn hạn chế nên chưa thể truyền đạt rõ ý để bạn hiểu, mình rất xin lỗi về điều này.
Mình có gửi lại file mình đã chỉnh sửa code và sử dụng được lên để bạn có thể hiểu rõ hơn tình huống của mình.
nếu có thể check giùm mình bạn hãy sửa phần đường dẫn lại cho đúng khi bạn download về máy bạn giúp mình nhé (2 file để dùng 1 thư mục)
Hiện tại khi nhấp vào "xuat file" code của mình sẽ chạy và cho ra 1 loạt file kết quả ở cùng thư mục chưa file excel nguồn, mỗi dòng là 1 file kết quả (word). ý tưởng của mình là khi mình nhấp vào "xuat file" excel sẽ đưa ra cho mình 2 option là "xuất tất cả các dòng" hay "xuất dòng x" (x do mình nhập vào, theo mình hiểu thì là dạng InputBox như bạn nói). Rất mong được bạ giúp đỡ. Trân trọng!

vubaduc1993 · 27/2/19

Có bác nào rảnh code hộ em tự động xuất file theo địa chỉ thư mục có sãn được không ạ ( em có thể về chỉnh sửa )
Thank các bác

batman1 · 27/2/19

kimmi268 đã viết:
Hiện tại khi nhấp vào "xuat file" code của mình sẽ chạy và cho ra 1 loạt file kết quả ở cùng thư mục chưa file excel nguồn, mỗi dòng là 1 file kết quả (word). ý tưởng của mình là khi mình nhấp vào "xuat file" excel sẽ đưa ra cho mình 2 option là "xuất tất cả các dòng" hay "xuất dòng x" (x do mình nhập vào, theo mình hiểu thì là dạng InputBox như bạn nói). Rất mong được bạ giúp đỡ. Trân trọng!

Biết ngay mà. Lại phải viết lần nữa.

̣Thôi, làm lần cuối. Tập tin Ecel và Word ở cùng thư mục. Để nguyên "all" và nhấn OK hoặc nhập vd. 2, 5, 8 (2,5,8) và nhấn OK. Code không kiểm tra lỗi nhập vd. 2.3, 5, 8 hoặc 1234 khi dữ liệu chỉ có tới dòng vd. 200

Mã:

Sub bbntcv()
Const wdReplaceAll = 2
    Dim indexs As String, dong, data()
    Dim num_of_column As Long
    Dim lastRow As Long, k As Long, i As Long, j As Long
    Dim template As Object, t As Object

    With Sheet6
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 2 Then Exit Sub
    End With
    indexs = InputBox("Hay nhap cac chi so dong tren sheet hoac de nguyen ""all"" va nhan OK", "Nhap chi so dong", "all")
    If indexs = "" Then Exit Sub
    
    data = Sheet6.Range("A1:N" & lastRow).Value
    
    If indexs = "all" Then
        ReDim dong(0 To UBound(data) - 2)
        For k = 0 To UBound(dong)
            dong(k) = k + 2
        Next k
    Else
        dong = Split(Replace(indexs, " ", ""), ",")
    End If
    
    num_of_column = 14
    
    With CreateObject("word.application")
'        .Visible = True
        For i = 0 To UBound(dong)
            k = dong(i)
            Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                If j = 4 Or j = 5 Then
                    data(k, j) = Format(data(k, j), "HH:mm")
                ElseIf j = 9 Then
                    data(k, j) = Round(data(k, j), 3)
                End If
                t.Find.Execute findtext:=data(1, j), ReplaceWith:=data(k, j), Replace:=wdReplaceAll
            Next j
            With template
                .SaveAs Filename:=ThisWorkbook.Path & "\" & k & "-BBNTCV.doc"
                .Close
            End With
        Next i
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
    
End Sub

harukenshiro · 27/2/19

Sau khi đọc bài Tổng quan về Dictionary của anh kyo , em nghĩ nó rất phù hợp để đẩy nhanh tiến độ công việc của bản thân nhưng khi áp dụng vẫn chưa thành công, em mạn phép gửi code của em lên để các anh xem nó ko phù hợp ở chỗ nào. Mục đích của em là :

- Tạo một Dictionary có cột A của file Data làm key, cột B, I (trong code em vẫn chưa có làm cột I) làm Item.
- Nạp Dictionary từ file Main, sau đó lấy cột AG làm giá trị cần tìm, làm tương tự như vlookup để xuất giá trị ở cột DD=B, cột DE = I.(Code nằm ở Module 1).

Mong các anh có thể sửa và giải thích giúp cho em để em ghi nhớ ạ. Em xin cảm ơn trước.

batman1 · 28/2/19

harukenshiro đã viết:
Sau khi đọc bài Tổng quan về Dictionary của anh kyo , em nghĩ nó rất phù hợp để đẩy nhanh tiến độ công việc của bản thân nhưng khi áp dụng vẫn chưa thành công, em mạn phép gửi code của em lên để các anh xem nó ko phù hợp ở chỗ nào. Mục đích của em là :

Mong các anh có thể sửa và giải thích giúp cho em để em ghi nhớ ạ. Em xin cảm ơn trước.

Bạn thử xem.

Đừng hỏi gì nữa vì tôi chú thích từng dòng code rồi.

Mã:

Sub thudictionary()
Dim wb As Workbook, ws As Worksheet
Dim data(), result(), dic, item
Dim i As Long, lastRow As Long
'    tap tin Main.xlsb va Data.xlsm o trong cung thu muc
    Set wb = Application.Workbooks.Open(ThisWorkbook.Path & "\Data.xlsm")
    With wb.Worksheets("Master in Google Drive")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'        khong co du lieu thi ket thuc
        If lastRow < 2 Then Exit Sub
'        lay du lieu vao mang data
        data = .Range("A2:I" & lastRow).Value
    End With
    wb.Close
    
'    kiem tra xem VNSO co du lieu hay khong
    Set ws = ThisWorkbook.Sheets("VNSO")
    With ws
'        neu co ket qua cu thi xoa
        lastRow = .Cells(Rows.Count, "DD").End(xlUp).Row
        If lastRow > 1 Then .Range("DD2:DE" & lastRow).ClearContents
'        dong cuoi cung co du lieu o cot AG
        lastRow = .Cells(Rows.Count, "AG").End(xlUp).Row
'        khong co du lieu thi ket thuc
        If lastRow < 2 Then Exit Sub
    End With
    
    Set dic = CreateObject("Scripting.Dictionary")
    With dic
'        duyet tung dong cua mang data, them key va item. item la mang co 2 phan tu, tu cot B va cot I
        For i = 1 To UBound(data)
            If Not .exists(data(i, 1)) Then
                ReDim item(1 To 2)
'                tu cot B
                item(1) = data(i, 2)
'                tu cot I
                item(2) = data(i, 9)
'                them vao tu dien
                .Add data(i, 1), item
            End If
        Next
    End With
'    cho cac gia tri can tim tu cot AG cua sheet VNSO vao mang data. Lay du 1 dong
    data = ws.Range("AG2:AG" & lastRow + 1).Value
    ReDim result(1 To UBound(data) - 1, 1 To 2)
'    duyet mang data, khong xet dong cuoi cung lay them
    For i = 1 To UBound(data) - 1
        If dic.exists(data(i, 1)) Then
'            doc ra cot B va I tu tap tin Data.xlsm, da ghi trong item
            item = dic.item(data(i, 1))
'            ghi ket qua vao mang result
            result(i, 1) = item(1)
            result(i, 2) = item(2)
        End If
    Next
'    dap mang result xuong sheet
    ws.Range("DD2").Resize(UBound(result), 2).Value = result
    
    Set dic = Nothing
End Sub

kimmi268 · 28/2/19

batman1 đã viết:

Biết ngay mà. Lại phải viết lần nữa.

̣Thôi, làm lần cuối. Tập tin Ecel và Word ở cùng thư mục. Để nguyên "all" và nhấn OK hoặc nhập vd. 2, 5, 8 (2,5,8) và nhấn OK. Code không kiểm tra lỗi nhập vd. 2.3, 5, 8 hoặc 1234 khi dữ liệu chỉ có tới dòng vd. 200

Mã:

Sub bbntcv()
Const wdReplaceAll = 2
    Dim indexs As String, dong, data()
    Dim num_of_column As Long
    Dim lastRow As Long, k As Long, i As Long, j As Long
    Dim template As Object, t As Object

    With Sheet6
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 2 Then Exit Sub
    End With
    indexs = InputBox("Hay nhap cac chi so dong tren sheet hoac de nguyen ""all"" va nhan OK", "Nhap chi so dong", "all")
    If indexs = "" Then Exit Sub
   
    data = Sheet6.Range("A1:N" & lastRow).Value
   
    If indexs = "all" Then
        ReDim dong(0 To UBound(data) - 2)
        For k = 0 To UBound(dong)
            dong(k) = k + 2
        Next k
    Else
        dong = Split(Replace(indexs, " ", ""), ",")
    End If
   
    num_of_column = 14
   
    With CreateObject("word.application")
'        .Visible = True
        For i = 0 To UBound(dong)
            k = dong(i)
            Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                If j = 4 Or j = 5 Then
                    data(k, j) = Format(data(k, j), "HH:mm")
                ElseIf j = 9 Then
                    data(k, j) = Round(data(k, j), 3)
                End If
                t.Find.Execute findtext:=data(1, j), ReplaceWith:=data(k, j), Replace:=wdReplaceAll
            Next j
            With template
                .SaveAs Filename:=ThisWorkbook.Path & "\" & k & "-BBNTCV.doc"
                .Close
            End With
        Next i
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
   
End Sub

Tuyệt vời, mình rất rất cảm ơn bạn. Chúc bạn và gia đình luôn hạnh phúc!

anh1234 · 4/3/19

Dear Các bác.
Sau khi chuyển máy, chuyển từ excel 2007 lên office 2010, toàn bộ các Code VBA liên quan đến gửi mail, đều báo lỗi:
Run-time error'-2147417851(80010105)'.
Method 'To' of object '_Mailtem'faied.
Em không rõ là lỗi code, hay em chưa cài đầy đủ các phần trong ofice 2010. Các code này, em chuyển sang máy cũ của em 2007 vẫn dùng vẫn bình thường, sang máy mới cài ofice 2010 là không chạy được.

Kính mong các bác giúp em ạ.

fukuchan · 4/3/19

Xin chào mọi người, mình mới tập tành viết code nên còn rất nhiều điều chưa biết. Vì dụ mình có 2 câu text trong 2 ô excel như sau
1. Ngày13/2/2019
2. Tổ 23 phường Hòa Hải quận Ngũ Hành Sơn Thành phố Đà Nẵng
Bây giờ mình muốn tách từng cụm từ của mỗi câu sau ra thành từng ô excel ở 1 sheet khác thì phải dùng code vba như thế nào ạ?
Nhờ mọi người giúp đỡ

snow25 · 4/3/19

fukuchan đã viết:
Xin chào mọi người, mình mới tập tành viết code nên còn rất nhiều điều chưa biết. Vì dụ mình có 2 câu text trong 2 ô excel như sau
1. Ngày13/2/2019
2. Tổ 23 phường Hòa Hải quận Ngũ Hành Sơn Thành phố Đà Nẵng
Bây giờ mình muốn tách từng cụm từ của mỗi câu sau ra thành từng ô excel ở 1 sheet khác thì phải dùng code vba như thế nào ạ?
Nhờ mọi người giúp đỡ

Tách như thế nào cho cái vị dụ coi.

fukuchan · 4/3/19

snow25 đã viết:
Tách như thế nào cho cái vị dụ coi.

Mình muốn tách như dưới này á nhưng ko biết nên dùng code như thế nào
trước khi tách

sau khi tách

snow25 · 4/3/19

fukuchan đã viết:
Mình muốn tách như dưới này á nhưng ko biết nên dùng code như thế nào
trước khi tách
View attachment 213133
sau khi tách
View attachment 213134

Bạn phải biết quy luật của nó mới viết được code.Bạn tìm hiểu xem quy luật của bạn là gì.

.

fukuchan · 4/3/19

snow25 đã viết:
Bạn phải biết quy luật của nó mới viết được code.Bạn tìm hiểu xem quy luật của bạn là gì..

cái ô đầu thì quy luật là ngày/tháng/ năm sẽ cách nhau bằng dấu "/", còn câu dưới thì mình đang muốn nó tách theo từng ký tự chỉ định (tổ/phường/quận/thành phố) nhưng mà đoạn code thì không biết làm sao để mô tả được việc dòng text sẽ cách nhau tại dấu "/"

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

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

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

Chuyên gia GPE

❆❆❆❆❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆❆❆❆❆

|||||||||||||

❆❆❆❆❆❆❆❆❆❆❆❆

|||||||||||||

❆❆❆❆❆❆❆❆❆❆❆❆

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

Thành viên gắn bó

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

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

/(hông là gì!

Chuyên gia GPE

/(hông là gì!

Chuyên gia GPE

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

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

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

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

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

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

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

File đính kèm

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

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

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

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

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

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

Thành viên gắn bó

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

Thành viên gắn bó

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

File đính kèm

Thành viên gắn bó

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

File đính kèm

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

❆❆❆❆❆❆❆❆❆❆❆❆

❆❆❆❆❆❆❆❆❆❆❆❆

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

❆❆❆❆❆❆❆❆❆❆❆❆

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

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

/(hông là gì!

❆❆❆❆❆❆❆❆❆❆❆❆

/(hông là gì!

Thành viên mới

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

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

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

Thành viên mới

Thành viên mới

File đính kèm

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 mới

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên mới

File đính kèm

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

Thành viên mới