Tách chuỗi 1 cell thành từng phần và kết hợp mỗi phần với cell tương ứng (1 người xem)

[krvn]

Chào mọi người!
Mình có một file Exel về Linh kiện điện tử cần xử lý dữ liệu các Cells theo một số cho trước, vì trình độ Exel còn hạn chế nên thật khó khăn khi phải ngồi dò tay và dùng một số thủ thuật cơ bản của Exel mà mình biết để xử lý dạng file này.Các bạn giúp mình giải bài toán khó này nhé!Bài toán này có thể dùng Hàm nào đó hay Macro để làm được không?Hãy cho mình file Macro giải bài toán đó hay chia sẻ ra diễn đàn này để mình cùng các bạn khác biết cách xử lý khi gặp phải những dạng dữ liệu kiểu này.
Nếu có thể gửi giúp mình tới Email: krvn_friend_telecom@yahoo.com
Cảm ơn các bạn giúp đỡ!
P/S:Mình gửi file đính kèm, trong đó có 2 sheets ( DemK và Xu_Ly). Các bạn giúp mình làm Sheet Xu_ly
và đưa ra kết quả giống Sheet DemK mình đã làm thủ công.
Một lần nữa cảm ơn các bạn!

 

[sealand]

Bạn tham khảo và tuỳ biến cho công việc của mình nhé

Option Explicit
Sub suly()
Dim Str1, Str2 As String
Dim Rg1, Rg2 As Range
Dim tam, i, j
Set Rg1 = Sheet3.[a1:c70]
Set Rg2 = Sheet2.[a1]
Sheet2.Columns("A:B").Clear
For i = 1 To Rg1.Rows.Count
Str1 = Trim(Rg1.Cells(i, 1))
Str2 = Application.WorksheetFunction.Clean(Rg1.Cells(i, 3))
If InStr(1, Str2, ",") = 0 Then
Rg2 = Str2
Rg2.Offset(, 1) = Str1
Set Rg2 = Rg2.Offset(1)
Else
tam = Split(Str2, ",")
For j = 0 To UBound(tam) - 1
Rg2 = Trim(tam(j))
Rg2.Offset(, 1) = Str1
Set Rg2 = Rg2.Offset(1)
Next
End If
Next
End Sub

 

[krvn]

Cảm ơn bác Sealand nhiều!Bác giúp thật nhanh!Song em thử Test cái sheet Kqua của bác tại A9:B9 thì thấy A9 không phải là "MC9" và B9 không phải là "22uF,16v,3528,MLCC".Em chưa Test tiếp nữa, song như vậy ta có thể kết luận thuật toán cho bài toán này chưa đúng, phải vậy không bác? Bác giúp em xem lại vị trí không đúng đó và có thể sẽ ở vị trí khác nữa để sửa thuật toán chính xác hơn.
Cảm ơn bác vì sự giúp đỡ!

 

[ndu96081631]

Cảm ơn bác Sealand nhiều!Bác giúp thật nhanh!Song em thử Test cái sheet Kqua của bác tại A9:B9 thì thấy A9 không phải là "MC9" và B9 không phải là "22uF,16v,3528,MLCC".Em chưa Test tiếp nữa, song như vậy ta có thể kết luận thuật toán cho bài toán này chưa đúng, phải vậy không bác? Bác giúp em xem lại vị trí không đúng đó và có thể sẽ ở vị trí khác nữa để sửa thuật toán chính xác hơn.
Cảm ơn bác vì sự giúp đỡ!

Nhìn vào file của bạn, tôi không hiểu mấy về nguyên tắc tách chuổi
Nói rõ chút đi:
- Tách là tách thế nào?
- Cell nào cần tách và nguyên tắc tách ra sao?
-----------------------------------------------------------
Ah... tôi hiểu rồi
Dùng code này xem:

Sub TachChuoi()
  Dim Clls As Range, SrcRng As Range, Arr, i As Long
  i = 1
  Set SrcRng = Sheets("Xu ly").Range(Sheets("Xu ly").[A1], Sheets("Xu ly").[A65536].End(xlUp))
  For Each Clls In SrcRng
    With WorksheetFunction
      Arr = Split(Replace(.Trim(.Clean(Clls.Offset(, 2).Value)), " ", ""), ",")
      Sheets("Demo_OK").Cells(i, "E").Resize(UBound(Arr) + 1).Value = Clls
      Sheets("Demo_OK").Cells(i, "D").Resize(UBound(Arr) + 1).Value = .Transpose(Arr)
      i = i + UBound(Arr) + 1
    End With
  Next
End Sub

 

[sealand]

Về thuật toán có hay không mình không nói chứ sai thì không. Cái sai ở mình đôi khi lẫn giữa Count (Tính từ 1) và hàm Ubound (Tính từ 0).Mình nhầm 1 chút ở đoạn này:

For j = 0 To UBound(tam)-1

Sửa thành:

For j = 0 To UBound(tam)

Mình chép phần Demo sang đối chiếu thấy đúng cả.

 

[krvn]

Cảm ơn hai bác Sealand và ndu!Bài toán tách chuỗi dữ liệu đã được hai bác giải quyết hoàn hảo rồi.Bây giờ em muốn hỏi thêm một vấn đề khác nữa. Mong hai bác và mọi người cùng xem và giúp đỡ.
Vì diễn đàn hôm nay không thấy cho gửi file đính kèm nên em vẫn dựa vào dữ liệu gốc hôm trước nhé.
Cụ thể như sau:
1-Sheet 1: "Dulieudauvao" giống sheet "Xuly" hôm trước em gửi đính kèm.
2-Sheet 2: "Tachchuoi" giống sheet "Kqua" của bác Sealand đã làm.
3-Sheet 3: "Nhapdulieu1"
-Nhập tên linh kiện theo Sequence Comment: Nhập vào có thể là chữ ký tự hoặc số
-Nhập toạ độ X: Chỉ nhập là số( có thể là số âm hoặc dương)
-Nhập toạ độ Y: Chỉ nhập là số( có thể là số âm hoặc dương)
Yêu cầu: Cho phép nhập dữ liệu vào 3 hàng như trên.Khi ấn nút, dữ liệu sẽ được nhập vào sheet "Kqua".Có thể nhập dữ liệu vào nhiều lần khác nhau tuỳ ý.Dữ liệu sẽ được hiển thị trong sheet "Kqua" theo 4 trường: Sequence Comment, Part Comment, Toa do X, Toa do Y .Trường Part Comment được hiển thị bởi việc lọc và gán dữ liệu qua việc tách chuỗi tại sheet "Tachchuoi".
4-Sheet 4: "Kqua"
Hiển thị kết quả theo 4 trường như trên.
5-Sheet 5: "Nhapdulieu2"
-Nhập toạ độ Offset X: Nhập là số, có thể là âm hoặc dương
-Nhập toạ độ Offset Y: Nhập là số, có thể là âm hoặc dương
Yêu cầu:Khi nhập vào toạ độ Offset X, Y và ấn nút thì toạ độ X, Y tại sheet "Kqua" thay đổi theo và toạ độ X, Y mới sẽ bằng toạ độ X, Y cũ cộng với toạ độ Offset X, Y.
VD: Toạ độ X, Y cũ là: (-20:10)
Toạ độ Offset X,Y là: (1:2)
Thì toạ độ X, Y mới sẽ là (-19:12)
Mong các bác nghiên cứu và giúp em!
Cảm ơn các bác nhiều nhiều!

 

[sealand]

Nếu có thể anh em sẵn sàng thôi, nhưng đoán được ý bạn quả là khó. Ngay cả bạn nói tên các trường (Trong Excel cứ gọi là cột cho tiện) làm gì có tiêu đề nên không biết cột nào vào cột nào. Ngay cả cách vận hành của file bạn cũng nên hướng dẫn tỷ mỷ hơn, kết qủa mỗi lần nhập có lưu lại không. Kết quả lọc ghi nối vào hay xoá cũ điền mới.
Anh em sẵn sàng hỗ trợ, bạn cũng nên dành thời gian hướng dẫn chi tiết 1 chút. Như vậy, sẽ bớt đi nhũng công việc trung gian là tìm hiểu (Đôi khi còn hiểu sai)

Bạn xem file sau có phải không?

 

[krvn]

Vâng, cảm ơn bác Sealand!Em cũng không quen nhiều về những từ ngữ sử dụng cho Exel nên viết và diễn đạt đúng là làm khó hiểu cho các bác, và cũng vì em không thể Up được File đính kèm nên lại càng làm các bác hiểu sai ý, là điều dễ hiểu, em sẽ rút kinh nghiệm hơn.
Bác Sealand !Em sẽ gửi File Exel vào mail chữ ký của bác nhé!Bác xem và xử lý giúp em.Vì sheet "Kqua" sẽ là nơi mà em muốn lưu lại tất cả sau mỗi lần nhập vào và ấn nút tại sheet "Nhapdulieu1".Nó sẽ lưu nhiều giá trị như khi em nhập vào T1,MC1,R1,R36...và tương tự Toạ độ X, Y cũng vậy, nó sẽ lưu lại hết.Khi em nhập đủ những linh kiện em cần thì sheet "Kqua' sẽ có đủ thành phần Sequence Comment, Part Comment, Toa do X Toa do Y .Đặc biệt ở sheet "Kqua" này chỉ lưu những tên em nhập vào thôi, chứ không lưu và hiển thị mọi tên khác cùng Sequence Comment hay Part Comment như bác làm trong file krvn2.rar gửi đính kèm ở trên.Còn đối với sheet "Nhapdulieu2" vì tại sheet "Kqua" có Sequence Comment đã hiển thị rồi và không cần thay đổi nên em không cần nhập vào nữa, em chỉ muốn nhập thay đổi toạ độ X, Y một khoảng cách thêm nào đó thôi, nó sẽ tự động cộng vào tất cả các toạ độ X,Y cho mỗi linh kiện hiển thị trong sheet "Kqua" và lưu kết quả đó.Em muốn giải quyết bài toán tuần tự là phải nhập vào sheet "Nhapdulieu1" trước, sau đó lưu kết quả.Khi nào cần thay đổi toạ độ X, Y và thêm một khoảng cách nào đó thì em mới dùng sheet "Nhapdulieu2".Khi nhập liệu vào sheet "Nhapdulieu2" và ấn nút thì kết quả trong sheet "Kqua" sẽ thay đổi theo, toạ độ Offset X, Y sẽ được cộng thêm vào toạ độ X, Y cũ có trong sheet "Kqua" của việc "Nhapdulieu1". Bác xem file em gửi tại mail cho bác nhé.Có thể em diễn đạt vẫn lủng củng và khó hiểu nhưng bác cũng cố gắng cho.
Cảm ơn bác nhiều lắm!

 

[ldhm]

Mình có sưu tâm đuoc môt đoan mã chuyên bảng tư Word sang Excel nhung có đoan này mÌNH không hiêu, mong mọi ngưoi giai thich cho mình vơi nhé. Ket qua chay ra trong 1sheet cÁC bảng lân lưot theo chieu dung, minh muon lan luot theo chieu ngang các bạn giup mình voi nhe! MÌNH cám ơn nhiêu!:
Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Full Code:
Option Explicit
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim resultRow As Long
Dim resultCol As Integer
Dim tableStart As Integer
Dim tableTot As Integer
On Error Resume Next
ActiveSheet.Range("A:AZ").ClearContents
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
tableNo = wdDoc.tables.Count
tableTot = wdDoc.tables.Count
If tableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf tableNo > 1 Then
tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
"Enter the table to start from", "Import Word Table", "1")
End If
resultRow = 2
For tableStart = 1 To tableTot
With .tables(tableStart)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
Next iCol
resultRow = resultRow + 1
Next iRow
End With
resultRow = resultRow
Next tableStart
End With

End Sub