[Cần giúp đỡ] Code update data vào file excel hàng ngày

Liên hệ QC
Datcdt2k9

Datcdt2k9

Thành viên hoạt động
Tham gia
27/12/19
Bài viết
109
Được thích
11
Chào mọi người
Em đang gặp vấn đề nếu làm thủ công sẽ mất nhiều thời gian
Vì vậy em đăng lên diễn đàn nhờ mọi người giúp đỡ
Khi Paste data vào cột C (bảng trên )=> chạy code => Data sẽ ra như bảng dưới và khi update data mới dữ liệu sẽ update vào dòng kế tiếp( trong ví dụ data cũ update tới hàng 23, nếu update data mới khi run code update vào dòng 24 trở đi)
Các trường hợp có thể phát sinh em đã tổng hợp trong file
Mong các anh chị giúp đỡ. Em xin cảm ơn
1607769830534.png
 

File đính kèm

  • TEST FILL DOWN_V01.xlsm
    23.4 KB · Đọc: 9
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nhattanktnn đã viết:
Do tôi thấy bạn có thay đổi tên sheet xuất kết quả (mà bạn không biết nên sửa cả function), nên rong code tôi thêm đoạn này:
Mã: 
Set Ws = Sheets("KQ")
Nếu bạn muốn thay đổi xuất kết quả sang sheet khác thì sửa tên sheet trong dấu ngoặc kép, còn lại không thay đổi gì
Nhấp chuột vào đây để mở rộng...
Uk cái này mình đã tùy biến thay tên sheet trong từng code và tạo button khi muốn xuất kết quả sang sheet cần.Nhưng bây giờ mình muốn add thêm cột mở rộng bên sheet nhaplieu để sau này có thể thêm trường dữ liệu nào đó, trong bài mình muốn mở rộng tới cột K
 
Upvote 0
Nhattanktnn đã viết:
Do tôi thấy bạn có thay đổi tên sheet xuất kết quả (mà bạn không biết nên sửa cả function), nên rong code tôi thêm đoạn này:
Mã: 
Set Ws = Sheets("KQ")
Nếu bạn muốn thay đổi xuất kết quả sang sheet khác thì sửa tên sheet trong dấu ngoặc kép, còn lại không thay đổi gì
Nhấp chuột vào đây để mở rộng...
Bạn kiểm tra giúp mình, code không tách được dải( ví dụ VQ1902OFA100-102) => Run code báo lỗi bạn ạ. Dải đơn ví dụ VQ2002OFA302 thì tách ok.
 
Upvote 0
Datcdt2k9 đã viết:
Bạn kiểm tra giúp mình, code không tách được dải( ví dụ VQ1902OFA100-102) => Run code báo lỗi bạn ạ. Dải đơn ví dụ VQ2002OFA302 thì tách ok.
Nhấp chuột vào đây để mở rộng...
Dữ liệu còn kiểu nào khác nữa không? lúc đầu bạn bảo liệt kê hết kiểu rồi, tôi không thấy có kiểu đơn như vậy
sửa chỗ này:
Mã: 
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
Thành:
Mã: 
On Error Resume Next
    SL(I) = 1
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
On Error GoTo 0
 
Upvote 0
Nhattanktnn đã viết:
Dữ liệu còn kiểu nào khác nữa không? lúc đầu bạn bảo liệt kê hết kiểu rồi, tôi không thấy có kiểu đơn như vậy
sửa chỗ này:
Mã: 
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
Thành:
Mã: 
On Error Resume Next
    SL(I) = 1
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
On Error GoTo 0
Nhấp chuột vào đây để mở rộng...
Từ đầu bài mình đăng là có
Nhattanktnn đã viết:
Dữ liệu còn kiểu nào khác nữa không? lúc đầu bạn bảo liệt kê hết kiểu rồi, tôi không thấy có kiểu đơn như vậy
sửa chỗ này:
Mã: 
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
Thành:
Mã: 
On Error Resume Next
    SL(I) = 1
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
On Error GoTo 0
Nhấp chuột vào đây để mở rộng...
Ok mình check ok rồi bạn ạ, file lúc dầu mình gửi có mà nhỉ
 
Upvote 0
Nhattanktnn đã viết:
Dữ liệu còn kiểu nào khác nữa không? lúc đầu bạn bảo liệt kê hết kiểu rồi, tôi không thấy có kiểu đơn như vậy
sửa chỗ này:
Mã: 
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
Thành:
Mã: 
On Error Resume Next
    SL(I) = 1
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
On Error GoTo 0
Nhấp chuột vào đây để mở rộng...
mình nhờ bạn chút nhé, mình có file cần thống kê ra các giá trị NG khi sau khi filter mà hành động lần lượt, lọc giá trị NG lần lượt từng cột và copy giá trị sau khi lọc sang 1 sheet "KQ"=> mình có giải thích kĩ trong file rồi, bạn giúp mình với nhé
1608818332833.png
 

File đính kèm

  • filter NG.xlsm
    23.2 KB · Đọc: 4
Upvote 0
Datcdt2k9 đã viết:
mình nhờ bạn chút nhé, mình có file cần thống kê ra các giá trị NG khi sau khi filter mà hành động lần lượt, lọc giá trị NG lần lượt từng cột và copy giá trị sau khi lọc sang 1 sheet "KQ"=> mình có giải thích kĩ trong file rồi, bạn giúp mình với nhé
View attachment 251776
Nhấp chuột vào đây để mở rộng...
Thử code này xem:
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), I&, J&, K&, N&, Txt$, U1&, U2&, ColName$
With Sheets("Data")
    sArr = .Range("R3:AH" & .Cells(.Rows.Count, "AH").End(xlUp).Row).Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1, 1 To U2 + 2)
    For I = 4 To U2
        For J = 1 To U1
            Txt = LCase(Trim(sArr(J, I)))
            If Txt = "ng" Then
                N = N + 1
                For K = 1 To U2
                    dArr(N, K + 1) = sArr(J, K)
                Next
                dArr(N, 1) = N
                ColName = WorksheetFunction.Substitute(.Cells(1, I + 17).Address(0, 0), 1, "")
                dArr(N, U2 + 2) = "Giá tri NG côt " & ColName
            End If
        Next
    Next
End With
With Sheets("KQ")
    .Range("A3:S10000").Clear
    .Range("A3").Resize(N, U2 + 2) = dArr
End With
End Sub
 
Upvote 0
Nhattanktnn đã viết:
Thử code này xem:
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), I&, J&, K&, N&, Txt$, U1&, U2&, ColName$
With Sheets("Data")
    sArr = .Range("R3:AH" & .Cells(.Rows.Count, "AH").End(xlUp).Row).Value
    U1 = UBound(sArr, 1): U2 = UBound(sArr, 2)
    ReDim dArr(1 To U1, 1 To U2 + 2)
    For I = 4 To U2
        For J = 1 To U1
            Txt = LCase(Trim(sArr(J, I)))
            If Txt = "ng" Then
                N = N + 1
                For K = 1 To U2
                    dArr(N, K + 1) = sArr(J, K)
                Next
                dArr(N, 1) = N
                ColName = WorksheetFunction.Substitute(.Cells(1, I + 17).Address(0, 0), 1, "")
                dArr(N, U2 + 2) = "Giá tri NG côt " & ColName
            End If
        Next
    Next
End With
With Sheets("KQ")
    .Range("A3:S10000").Clear
    .Range("A3").Resize(N, U2 + 2) = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn giúp mình edit code sao cho giá trị "NG" sang sheet KQ được tô màu và tối ưu 1 chút cho mình cột KQ mong muốn bên sheet KQ ( lấy tên cột NG thực tế U1,V1...AH1 bên sheet Data. U1(The tich), V1(BGA)...AH(TT2).Mình xin gửi lại file chi tiết
 

File đính kèm

  • filter NG.xlsm
    27 KB · Đọc: 9
  • 1608975532130.png
    1608975532130.png
    273.1 KB · Đọc: 11
Upvote 0
Datcdt2k9 đã viết:
Bạn giúp mình edit code sao cho giá trị "NG" sang sheet KQ được tô màu và tối ưu 1 chút cho mình cột KQ mong muốn bên sheet KQ ( lấy tên cột NG thực tế U1,V1...AH1 bên sheet Data. U1(The tich), V1(BGA)...AH(TT2).Mình xin gửi lại file chi tiết
Nhấp chuột vào đây để mở rộng...
Chạy thử
Mã: 
Sub XYZ()
  Dim sArr(), aTD(), Res()
  Dim i&, j&, c&, k&, sRow&, sCol&, tmp$

  With Sheets("Data")
    aTD = .Range("R1:AH1").Value
    sArr = .Range("R3", .Range("AH" & Rows.Count).End(xlUp)).Value
    sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
    ReDim Res(1 To sRow, 1 To sCol + 2)
  End With
  For j = 4 To sCol
    For i = 1 To sRow
      tmp = LCase(sArr(i, j))
      If tmp = "ng" Then
        k = k + 1
        Res(k, 1) = k
        For c = 1 To sCol
          Res(k, c + 1) = sArr(i, c)
          sArr(i, c) = Empty
        Next c
        Res(k, sCol + 2) = "Giá tri NG côt " & aTD(1, j) & "=> Check " & aTD(1, j)
      End If
    Next i
  Next j
  With Sheets("KQ")
    .Range("A3:S10000").Clear
    .Range("A3").Resize(k, sCol + 2) = Res
  End With
End Sub
 
Upvote 0
HieuCD đã viết:
Chạy thử
Mã: 
Sub XYZ()
  Dim sArr(), aTD(), Res()
  Dim i&, j&, c&, k&, sRow&, sCol&, tmp$

  With Sheets("Data")
    aTD = .Range("R1:AH1").Value
    sArr = .Range("R3", .Range("AH" & Rows.Count).End(xlUp)).Value
    sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
    ReDim Res(1 To sRow, 1 To sCol + 2)
  End With
  For j = 4 To sCol
    For i = 1 To sRow
      tmp = LCase(sArr(i, j))
      If tmp = "ng" Then
        k = k + 1
        Res(k, 1) = k
        For c = 1 To sCol
          Res(k, c + 1) = sArr(i, c)
          sArr(i, c) = Empty
        Next c
        Res(k, sCol + 2) = "Giá tri NG côt " & aTD(1, j) & "=> Check " & aTD(1, j)
      End If
    Next i
  Next j
  With Sheets("KQ")
    .Range("A3:S10000").Clear
    .Range("A3").Resize(k, sCol + 2) = Res
  End With
End Sub
[/QUOTE]
Nhấp chuột vào đây để mở rộng...

HieuCD đã viết:
Chạy thử
Mã: 
Sub XYZ()
  Dim sArr(), aTD(), Res()
  Dim i&, j&, c&, k&, sRow&, sCol&, tmp$

  With Sheets("Data")
    aTD = .Range("R1:AH1").Value
    sArr = .Range("R3", .Range("AH" & Rows.Count).End(xlUp)).Value
    sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
    ReDim Res(1 To sRow, 1 To sCol + 2)
  End With
  For j = 4 To sCol
    For i = 1 To sRow
      tmp = LCase(sArr(i, j))
      If tmp = "ng" Then
        k = k + 1
        Res(k, 1) = k
        For c = 1 To sCol
          Res(k, c + 1) = sArr(i, c)
          sArr(i, c) = Empty
        Next c
        Res(k, sCol + 2) = "Giá tri NG côt " & aTD(1, j) & "=> Check " & aTD(1, j)
      End If
    Next i
  Next j
  With Sheets("KQ")
    .Range("A3:S10000").Clear
    .Range("A3").Resize(k, sCol + 2) = Res
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
mình đã test thử, giá trị NG bên sheet KQ vẫn chưa được tô màu giống sheet data, với mình cần sheet Data có bao nhiêu giá trị NG sẽ xuất ra cần ấy giá trị trong sheet KQ .Trong ví dụ là 15 giá trị NG, code của bạn ra 9 giá trị do có giá trị NG nằm cùng hàng, mình cần tách riêng các giá trị này, mỗi giá trị NG là 1 hàng bạn ạ
 
Upvote 0
Datcdt2k9 đã viết:
mình đã test thử, giá trị NG bên sheet KQ vẫn chưa được tô màu giống sheet data, với mình cần sheet Data có bao nhiêu giá trị NG sẽ xuất ra cần ấy giá trị trong sheet KQ .Trong ví dụ là 15 giá trị NG, code của bạn ra 9 giá trị do có giá trị NG nằm cùng hàng, mình cần tách riêng các giá trị này, mỗi giá trị NG là 1 hàng bạn ạ
Nhấp chuột vào đây để mở rộng...
Chỉnh lại
Mã: 
Option Explicit
Option Compare Text

Sub XYZ()
  Dim sArr(), aTD(), Res(), Rng As Range
  Dim i&, j&, c&, k&, sRow&, sCol&, tmp$

With Sheets("Data")
  aTD = .Range("R1:AH1").Value
  sArr = .Range("R3", .Range("AH" & Rows.Count).End(xlUp)).Value
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  ReDim Res(1 To sRow, 1 To sCol + 2)
End With
 
With Sheets("KQ")
  .Range("A3:S10000").Clear
  For j = 4 To sCol
    For i = 1 To sRow
      tmp = LCase(sArr(i, j))
      If sArr(i, j) = "ng" Then
        k = k + 1
        Res(k, 1) = k
        For c = 1 To 3
          Res(k, c + 1) = sArr(i, c)
        Next c
        For c = 4 To sCol
          Res(k, c + 1) = sArr(i, c)
          If sArr(i, c) = "ng" Then
            If Rng Is Nothing Then
              Set Rng = .Cells(k + 2, c + 1)
            Else
              Set Rng = Union(Rng, .Cells(k + 2, c + 1))
              If Rng.Count = 50 Then
                Rng.Interior.ColorIndex = 40
                Set Rng = Nothing
              End If
            End If
          End If
        Next c
        Res(k, sCol + 2) = "Giá tri NG côt " & aTD(1, j) & "=> Check " & aTD(1, j)
      End If
    Next i
  Next j
  If k Then .Range("A3").Resize(k, sCol + 2) = Res
  If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 40
End With
End Sub
 
Upvote 0
HieuCD đã viết:
Chỉnh lại
Mã: 
Option Explicit
Option Compare Text

Sub XYZ()
  Dim sArr(), aTD(), Res(), Rng As Range
  Dim i&, j&, c&, k&, sRow&, sCol&, tmp$

With Sheets("Data")
  aTD = .Range("R1:AH1").Value
  sArr = .Range("R3", .Range("AH" & Rows.Count).End(xlUp)).Value
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  ReDim Res(1 To sRow, 1 To sCol + 2)
End With

With Sheets("KQ")
  .Range("A3:S10000").Clear
  For j = 4 To sCol
    For i = 1 To sRow
      tmp = LCase(sArr(i, j))
      If sArr(i, j) = "ng" Then
        k = k + 1
        Res(k, 1) = k
        For c = 1 To 3
          Res(k, c + 1) = sArr(i, c)
        Next c
        For c = 4 To sCol
          Res(k, c + 1) = sArr(i, c)
          If sArr(i, c) = "ng" Then
            If Rng Is Nothing Then
              Set Rng = .Cells(k + 2, c + 1)
            Else
              Set Rng = Union(Rng, .Cells(k + 2, c + 1))
              If Rng.Count = 50 Then
                Rng.Interior.ColorIndex = 40
                Set Rng = Nothing
              End If
            End If
          End If
        Next c
        Res(k, sCol + 2) = "Giá tri NG côt " & aTD(1, j) & "=> Check " & aTD(1, j)
      End If
    Next i
  Next j
  If k Then .Range("A3").Resize(k, sCol + 2) = Res
  If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 40
End With
End Sub
Nhấp chuột vào đây để mở rộng...
ok mình cảm ơn bạn. mình check ok rồi => Bạn giúp mình khi run xong đồng thời excel cũng tự động nhảy sang sheet KQ để minh view luôn kết quả bạn ạ
=> bên sheet KQ data tới đâu thì all boders giúp mình tới đó, sau này mình không phải thực hiện kẻ bảng nhiều lần
Đây là dữ liệu khi chạy code xong chưa được kẻ bảng

1609065560425.png
 
Lần chỉnh sửa cuối:
Upvote 0
Nhattanktnn đã viết:
Lần sau có trích dẫn thì trích dẫn bài của tôi, lỡ hỏi giúp đỡ gì tôi còn có thông báo, biết để vào xem lại cho bạn. Cả 2 bài #15 và #16 bạn đầu trích dẫn câu của bạn rồi trả lời, tôi đâu có biết. Rút kinh nghiệm cho những bài sau này nhé
Nhấp chuột vào đây để mở rộng...
Sau thời gian sử dụng mình gặp vấn đề dữ liệu update hàng ngày có 1 số dòng data định dạng khác trong code bạn viết, run sẽ báo lỗi và do quá nhiều dòng nên mình không tìm được dòng nào sai để sửa
=> bạn giúp mình thêm code phát hiện lỗi dòng nào sai để mình tìm sửa được không
=> Khi run code báo lỗi sẽ trả về số thứ tự dòng đang bị lỗi để mình tìm và sửa bạn ạ.Mình cảm ơn
 
Upvote 0
Nhattanktnn đã viết:
Dữ liệu còn kiểu nào khác nữa không? lúc đầu bạn bảo liệt kê hết kiểu rồi, tôi không thấy có kiểu đơn như vậy
sửa chỗ này:
Mã: 
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
Thành:
Mã: 
On Error Resume Next
    SL(I) = 1
    SL(I) = 1 - Evaluate(Rex(sChuoi, "\d{3}-\d{3}"))
On Error GoTo 0
Nhấp chuột vào đây để mở rộng...
Chào bạn, mình đang gặp vấn đề với file dữ liệu do dữ liệu của mình có thay đổi chút so với dữ liệu trước kia mình nhờ bạn viêt code nên lên đây tìm lại bài để nhờ bạn giúp mình, dữ liệu của mình có update thêm cột Run Jig (J) và cột ECN (K) nên khi tách, code tách sai dữ liệu, bạn giúp mình tách dữ liệu như hình dưới , bên dưới=> Khi run code nhấn K4 bên sheet NhapLieu => Data sẽ update Kết quả như sheet K4.Bạn giúp mình với
1611582103795.png
1611582414880.png
 

File đính kèm

  • 1611582297077.png
    1611582297077.png
    212.4 KB · Đọc: 4
  • TEST FILL DOWN_V003_25_01.xlsm
    44.2 KB · Đọc: 7
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
246
Đọc
13K
trannguyen197
T
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
28
Đọc
602
Tuấn Bụng Bự
Tuấn Bụng Bự
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
Trả lời
9
Đọc
236
ptm0412
ptm0412
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
14
Đọc
269
ptm0412
ptm0412
B
Định dạng condition formatting, đếm hỗn hợp dữ liệu merge và không merge
Trả lời
7
Đọc
117
Hoàng Tuấn 868
H
T
Tối ưu hóa hàm lấy dữ liệu từ bảng Tổng sang bảng chi tiết
Trả lời
7
Đọc
212
Hoàng Tuấn 868
H
nguyenphuochien166
Cách Vlookup hoặc cách lấy thông tin dữ liệu có dấu mũ lũy thừa?
    • Cười
Trả lời
6
Đọc
108
tigertiger
tigertiger
T
Không đếm dữ liệu rỗng trong PivotTable
Trả lời
8
Đọc
1K
hoangtuaotrang_hp_vn
H
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
3
Đọc
114
batista911
B
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
1
Đọc
92
hoangtuaotrang_hp_vn
H
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
5
Đọc
155
kimtanmap
kimtanmap
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
1
Đọc
77
hoangtuaotrang_hp_vn
H
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
0
Đọc
49
huynhnhu1234
huynhnhu1234
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
7
Đọc
127
tranvansau278
T
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
119
Nguyễn Linh hn94
N
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
164
zarra
zarra
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Cảm ơn
    • Thích
Trả lời
5
Đọc
296
anhdepjai
A
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
17
Đọc
20K
DeTong
D
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
306
cantl
C
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom