Nhờ thêm vòng lặp cho file mảco có sẵn

Liên hệ QC

duydhk

Thành viên mới
Tham gia
9/12/15
Bài viết
11
Được thích
1
Hiện tại mình có đoạn code marco như sau

Sub process()
'
' process Macro
'
' Keyboard Shortcut: Ctrl+y
'
Windows("search_result 8IS6.csv").Activate
Range("Q2").Select 'mình muốn tăng lên thành Q3, Q4... sau khi chạy xong 1 lượt xử lý
Selection.Copy
Windows("sample.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
Application.Run "sample.xlsm!Sheet2.Demo1"
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("process").Select
ActiveWindow.SmallScroll Down:=-12
Range("G1").Select
ActiveSheet.Paste
Application.Run "sample.xlsm!Macro8"
Sheets("Summary").Select
Range("E8").Select 'mình muốn tăng lên thành F8, G8... sau khi chạy xong 1 lượt xử lý
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F8").Select
End Sub

Mình đang muốn cho marco tự chạy và muốn sau khi chạy xong marco cho 1 dòng thì sẽ tự chạy dòng tiếp theo và paste vào dòng tiếp theo
Ở đây mình cần 1 vòng loop để số dòng(Q2->Q3->Q4...) tự tăng lên cho đến khi ko có dữ liệu trong ô đuợc chỉ định là blank thì ngừng lại. Nhưng do ko biết và mới làm với excel nên mong đc các bạn giúp đỡ
 
Sub process()
Dim cll as range, rng1 as range, rng2 as range
rng1 = Range("Q2:Q4")
For each cll in rng1
cll.select
'.....'đoạn code cần chạy lặp lại
Next
rng2 = range("E8:G8")
for each cll in rng2
cll.select
'....'đoạn code cần chạy lặp lại
next
End sub
 
Hiện tại mình có đoạn code marco như sau

Sub process()
'
' process Macro
'
' Keyboard Shortcut: Ctrl+y
'
Windows("search_result 8IS6.csv").Activate
Range("Q2").Select 'mình muốn tăng lên thành Q3, Q4... sau khi chạy xong 1 lượt xử lý
Selection.Copy
Windows("sample.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
Application.Run "sample.xlsm!Sheet2.Demo1"
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("process").Select
ActiveWindow.SmallScroll Down:=-12
Range("G1").Select
ActiveSheet.Paste
Application.Run "sample.xlsm!Macro8"
Sheets("Summary").Select
Range("E8").Select 'mình muốn tăng lên thành F8, G8... sau khi chạy xong 1 lượt xử lý
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F8").Select
End Sub

Mình đang muốn cho marco tự chạy và muốn sau khi chạy xong marco cho 1 dòng thì sẽ tự chạy dòng tiếp theo và paste vào dòng tiếp theo
Ở đây mình cần 1 vòng loop để số dòng(Q2->Q3->Q4...) tự tăng lên cho đến khi ko có dữ liệu trong ô đuợc chỉ định là blank thì ngừng lại. Nhưng do ko biết và mới làm với excel nên mong đc các bạn giúp đỡ
Bạn làm gì mà cứ chọn ô, copy và dán liên tục vậy, làm như vậy code chạy rất lâu. Bạn muốn làm vấn đề gì thì cứ nêu câu hỏi và đưa file mẫu lên đây mọi người giúp cho chứ quay macro như vậy thì code chạy chậm mà hiệu quả lại không như ý muốn.
 
Mình có 1 file excel "sample.xlsm" và 1 file csv. Mình muốn làm như sau


1. Copy data từ ô Q2 của file CSV
2. Paste data vào ô B2 của sheet sample, sau đó xử lý đoạn data này
Xử lý file như sau :
a. Xuống dòng sau mỗi dấu ">"
b. Nếu sau dấu ">" mà chưa bị đóng tag("/>") thì dòng phía dưới phải lùi vào 2 space, giống như khi bạn copy 1 đoạn xml vào notepad ++ bạn sẽ nhìn thấy và hiểu ngay
Phần xử lý này chính là marco trong "sample.xlsm!Sheet2.Demo1" mà mình đã có
3. Sau khi xử lý data như yêu cần trên xong, data sẽ đc paste vào ô E2( hoặc paste thẳng vào ô G1 bên sheet "process")
4. Tại ô G1 mình dùng marco để chạy tiếp mấy lệnh replace để có đc data như mình muốn và so sánh đc với cell A1 để biết đc là data đó có những tag nào
5. Copy và paste data nhận đc ở trên từ ô C1-> C143 rồi paste vào E8 của sheet "summary"
6. Lặp lại từ đầu với Q3, Q4, Q5.... cho đến khi ô Qn là blank. Xử lý như các buớc trên và paste vào F8, G8.....


Mình đã làm marco cho hết các công đoạn từ 1 -> 5 nhưng ko biết nên đặt vòng lặp thế nào để xử lý tiếp cho các ô tiếp theo
 

File đính kèm

  • sample.xlsm
    85.5 KB · Đọc: 6
  • search_result 8IS6.zip
    171 KB · Đọc: 10
Vậy thì toàn bộ code của bạn như sau (Kể cả mình chuyển Sub Demo1 thành hàm Demo)

Mã:
Option Explicit
'---------------------------------


Sub ProcessDT()
Dim ShRou As Worksheet, ShDes As Worksheet, ClRou As Range, ClDes As Range, ClSave As Range
Dim Tm(), i
Set ShRou = Workbooks("search_result 8IS6").Worksheets("search_result 8IS6")
Set ShDes = Workbooks("sample").Worksheets("sample")
Set ClRou = ShRou.[Q1]
Set ClDes = ShDes.[B1]
ShDes.Cells.ClearContents
Do While ClRou.Value <> ""
ClDes.Value = ClRou.Value
Set ClSave = ShDes.Cells(ShDes.Rows.Count, "E").End(xlUp)
If ClSave.Value <> "" Then ClSave = ClSave.Offset(1)
Tm = Demo(ClDes.Value)
ClSave.Resize(UBound(Tm)) = Tm
Set ClRou = ClRou.Offset(1)
Set ClDes = ClDes.Offset(1)
Loop
Set ShRou = Nothing: Set ShDes = Nothing
Set ClRou = Nothing: Set ClDes = Nothing: Set ClSave = Nothing
End Sub

'----------------------------------------


Function Demo(Ch As String)
Dim Spq, U&, R&, N&, S&, ST
        Spq = Split(Replace(Ch, ">", ">?"), "?")
         U = UBound(Spq)
    While R < U
        If Spq(R) Like "<*" Then
                     R = R + 1
        Else
            Spq(R - 1) = Spq(R - 1) & Spq(R)
                     U = U - 1
            For N& = R To U:  Spq(N) = Spq(N + 1):  Next
        End If
    Wend
    For R = 0 To U - 1
        If Spq(R) Like "</*" Then
                S = Left$(S, Len(S) - 2)
            Spq(R) = S & Spq(R)
        Else
                ST = Split(Spq(R), "<")
            Spq(R) = S & Spq(R)
            If Not (Spq(R) Like "*/>" Or ST(UBound(ST)) Like "/*") Then S = S & "  "
        End If
    Next
        Demo = Application.Transpose(Spq)
End Function
 
@sealand

bạn có thể gửi cho mình xem thử file excel thực hiện đoạn code trên được ko. Thank bạn nhiều
 
ppc0312 Sorry bạn, chính vì mình paste code vào ko chạy đc và báo lỗi nên mình mới muốn xem thử file để xem có gì sai khác không.
 
Mình có 1 file excel "sample.xlsm" và 1 file csv. Mình muốn làm như sau


1. Copy data từ ô Q2 của file CSV
2. Paste data vào ô B2 của sheet sample, sau đó xử lý đoạn data này
Xử lý file như sau :
a. Xuống dòng sau mỗi dấu ">"
b. Nếu sau dấu ">" mà chưa bị đóng tag("/>") thì dòng phía dưới phải lùi vào 2 space, giống như khi bạn copy 1 đoạn xml vào notepad ++ bạn sẽ nhìn thấy và hiểu ngay
Phần xử lý này chính là marco trong "sample.xlsm!Sheet2.Demo1" mà mình đã có
3. Sau khi xử lý data như yêu cần trên xong, data sẽ đc paste vào ô E2( hoặc paste thẳng vào ô G1 bên sheet "process")
4. Tại ô G1 mình dùng marco để chạy tiếp mấy lệnh replace để có đc data như mình muốn và so sánh đc với cell A1 để biết đc là data đó có những tag nào
5. Copy và paste data nhận đc ở trên từ ô C1-> C143 rồi paste vào E8 của sheet "summary"
6. Lặp lại từ đầu với Q3, Q4, Q5.... cho đến khi ô Qn là blank. Xử lý như các buớc trên và paste vào F8, G8.....


Mình đã làm marco cho hết các công đoạn từ 1 -> 5 nhưng ko biết nên đặt vòng lặp thế nào để xử lý tiếp cho các ô tiếp theo
Ô Q2 của bạn có dữ liệu gì đâu mà copy bạn.
 
ppc0312Sorry bạn, chính vì mình paste code vào ko chạy đc và báo lỗi nên mình mới muốn xem thử file để xem có gì sai khác không.

Nếu không dược bạn post file có macro đó nhờ kiểm tra lại, như thế mới thuận lợi cho tác giả code đó cũng như người khác kiểm tra dùm bạn, còn không thì làm khó nhau rui.
 
ppc0312Sorry bạn, chính vì mình paste code vào ko chạy đc và báo lỗi nên mình mới muốn xem thử file để xem có gì sai khác không.

99% là bạn chép Code vào file Sample xong chạy luôn mà không mà không mở file Sereach... rồi. Mình soạn code dưa theo ý tưởng của bạn trong code bài 1 (Như code của bạn mặc định là 2 file đang mở) Đảm bảo File Sereach... đang mở
 

File đính kèm

  • sample.xlsm
    103.7 KB · Đọc: 1
Lần chỉnh sửa cuối:
sealand thank bạn. Mình vẫn mở cả 2 khi chạy code và nó báo lỗi ngay tại dòng khai báo worksheet rồi. Mình up ảnh lỗi từ file của bạn lên nhé
 

File đính kèm

  • error.jpg
    error.jpg
    58.6 KB · Đọc: 19
Vẫn có vấn đề tên file có đúng không? Bạn thử mở 2 file mình gửi đây xem sao.
Tốt nhất là bạn thêm đoạn code để mở file bạn chọn.
 

File đính kèm

  • Desktop.rar
    253.6 KB · Đọc: 7
giaiphap
data mình cần lấy trong file csv nó giống với data mình đang để trong ô B2 của file sample.xlmsMình save data cần xử lý ra file excell khác, bạn có thể tạo file csv khác rồi đặt tạm data vào ô Q2 của file csv mới tạo, sau đó chạy thử marco process() của mình thì sẽ hình dung ra ngay
Mình xin up lại 2 file này
 

File đính kèm

  • sample.xlsm
    85.5 KB · Đọc: 0
  • data test cua file csv.xlsx
    12.4 KB · Đọc: 0
  • search_result 8IS6.zip
    171 KB · Đọc: 0
Mình sử dụng 2 file bạn gửi rồi nhưng vẫn bị lỗi như vậy.
Ngoài ra code xử lý đoạn xuống dòng và lùi space bạn sửa lại đang bị hiện "0" ở đầu và làm mất phần tag mình muốn giữ để so sánh với ô A1-A143 trong sheet "process" ( vì trong nội dung mình muốn so sánh có vài tag trùng tên nhưng space khác nhau, nên mình phải giữ lại space để so sánh đc chính xác)
Bạn có thể dùng 2 file mình gửi ban đâu, xoá data trong sheet "sample" đi rồi chạy marco process() để xem kết quả. Cảm ơn bạn nhiều
 
Bạn làm như sau:
Đóng tất cả các cửa sổ Excell lại rồi tải file nén này về mở cả 2 file lên. Về sheet Sample của file Sample chạy code xem nào?
Mình đang dùng Office10 , không biết có lỗi theo phiên bản không? Còn cú pháp VBA mình tin là không có lỗi. Cái lỗi bạn nêu là không tìm thấy của sổ của file search_result 8IS6.csv
Các lỗi do Function DEMO thì bạn hoàn toàn có thể kiểm tra vì bạn viết ra, mình chỉ chuyển từ Sub sang Function. Nếu có gì sai sót bạn điều chỉnh lại. (Nói thật, với cách giải thích của bạn và dịch đoạn code của bạn thì hoa mắt quá)
 
Thank sealand, mình check lại file bạn gửi rồi, marco ko nhận vì ko khai báo extension cho file( search_result 8IS6.csv và sample.xlsm)


Nhưng code của bạn chỉ chạy và copy data từ bên csv qua và dừng ở bước số 2, còn từ bước 3 đến 6 thì chưa làm gì hết.


1. Copy data từ ô Q2 của file CSV
2. Paste data vào ô B2 của sheet sample, sau đó xử lý đoạn data này
Phần xử lý này chính là marco trong "sample.xlsm!Sheet2.Demo1" mà mình đã có
3. Sau khi xử lý data như yêu cần trên xong, data sẽ đc paste vào ô E2( hoặc paste thẳng vào ô G1 bên sheet "process")
4. Tại ô G1 mình dùng marco của mình để sửa data và copy kết quả, sau đó paste vào ô E8 tại sheet "summary". Hết 1 vòng

5. Lặp lại từ đầu với Q3, chạy các bước trên, paste vào F8.Tiếp tục với Q4, chạy các bước trên, paste vào G8
và cứ thế đến Qn, khi Qn = blank

Hiện tại mình chỉ cần làm sao khi thực hiện từ 1 đến 4, nó tự nhảy làm lại tự đầu với Q3 - xử lý- rồi paste vào F8, rồi lại Q4 - xử lý - paste vào G8
 
Lần chỉnh sửa cuối:
Thank all, mình đã làm đc rồi }}}}}
 
Web KT

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

Back
Top Bottom