leonardo86
Thành viên mới
- Tham gia
- 26/8/10
- Bài viết
- 2
- Được thích
- 0
Chào các bác,
Mình hiện đang có một vấn đề về chuyển dữ liệu từ Word vào Excel, đã có ý tưởng nhưng còn thiếu kiến thức để giải quyết. Mong các bác hỗ trợ.
Mình có 1 file Word với nhiều dữ liệu, trong đó có một số chuỗi đặc trưng theo đúng thứ tự, ví dụ:
Mình cần chuyển tất cả thông tin về tuyến viba và số giấy phép vào Excel. Nhưng hiện tại mình chỉ mới làm được việc là tách thông tin của lần tìm đầu tiên (Tram_A - Tram_B; 12345/GP) với đoạn code kèm theo. Mong các bác giúp mình làm sao chọn hết thông tin của các tuyến và số giấy phép để chuyển vào file Excel với từng cột tương ứng (vd Column A cho tên tuyến, Comumn B cho số giấy phép)
Cám ơn các bác nhiều.
Mình hiện đang có một vấn đề về chuyển dữ liệu từ Word vào Excel, đã có ý tưởng nhưng còn thiếu kiến thức để giải quyết. Mong các bác hỗ trợ.
Mình có 1 file Word với nhiều dữ liệu, trong đó có một số chuỗi đặc trưng theo đúng thứ tự, ví dụ:
...
viba Tram_A - Tram_B ... Số giấy phép 12345/GP
...
viba Tram_C - Tram_D ... Số giấy phép 12346/GP
...
viba Tram_E - Tram_F ... Số giấy phép 12346/GP
...
Mình cần chuyển tất cả thông tin về tuyến viba và số giấy phép vào Excel. Nhưng hiện tại mình chỉ mới làm được việc là tách thông tin của lần tìm đầu tiên (Tram_A - Tram_B; 12345/GP) với đoạn code kèm theo. Mong các bác giúp mình làm sao chọn hết thông tin của các tuyến và số giấy phép để chuyển vào file Excel với từng cột tương ứng (vd Column A cho tên tuyến, Comumn B cho số giấy phép)
Cám ơn các bác nhiều.
Mã:
Sub GrabUsage()
Dim FName As String, FD As FileDialog
Dim WApp As Object, WDoc As Object, WDR As Object
Dim ExR As Range
Set ExR = Selection ' Current location in Sheet Excel
[I] ' Chọn file Word [/I]
Set FD = Application.FileDialog(msoFileDialogOpen)
FD.Show
If FD.SelectedItems.Count <> 0 Then
FName = FD.SelectedItems(1)
Else
Exit Sub
End If
[I] ' Mở file Word[/I]
Set WApp = CreateObject("Word.Application")
' WApp.Visible = True
Set WDoc = WApp.Documents.Open(FName)
[I] ' Tìm chuỗi nhận dạng[/I]
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
[I] ' Tìm chuỗi "viba" trong GPTS[/I]
WApp.Selection.Find.Execute "viba"
[I] ' Di chuyển con trỏ đến đầu vị trí chuỗi cần lưu[/I]
WApp.Selection.MoveRight Unit:=1, Count:=2
[I] ' Chọn chuỗi [/I]
WApp.Selection.MoveRight Unit:=1, Count:=15, Extend:=1
[I]' Copy và paste vào Excel [/I]
Set WDR = WApp.Selection
ExR(1, 1) = WDR [I]' Đưa dữ liệu vào ô Excel đang chọn[/I]
[I] 'Tiếp tục tìm chuỗi số GPTS[/I]
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "/GP"
WApp.Selection.MoveRight Unit:=1, Count:=1
WApp.Selection.MoveLeft Unit:=1, Count:=9, Extend:=1
Set WDR = WApp.Selection
ExR(1, 2) = WDR [I]' Đưa dữ liệu vào ô bên phải ô đang chọn[/I]
WDoc.Close
WApp.Quit
End Sub
File đính kèm
Lần chỉnh sửa cuối: