Tổng hợp dữ liệu từ định dạng file .ARC (1 người xem)

baquang1984 · 27/7/17

Em chào thầy cô và anh chị trên diễn đàn!
Em có rất nhiều file xuất ra từ máy đo đạc ở định dạng file .ARC do vậy em đưa lên diễn đàn nhờ Thầy cô và anh chị trên diễn đàn viết giúp Code VBA tổng hợp từ các file .ARC và Excel theo mẫu file em gửi ạ
Em cảm ơn nhiều ạ!

ndu96081631 · 27/7/17

baquang1984 đã viết:
Em chào thầy cô và anh chị trên diễn đàn!
Em có rất nhiều file xuất ra từ máy đo đạc ở định dạng file .ARC do vậy em đưa lên diễn đàn nhờ Thầy cô và anh chị trên diễn đàn viết giúp Code VBA tổng hợp từ các file .ARC và Excel theo mẫu file em gửi ạ
Em cảm ơn nhiều ạ!

Bạn có thể dùng công cụ Get External Data trên Excel để làm. Xem video

Sau khi có dữ liệu, chỗ nào không vừa ý có thể sửa bằng tay không dùng code tùy ý

baquang1984 · 27/7/17

ndu96081631 đã viết:
Bạn có thể dùng công cụ Get External Data trên Excel để làm. Xem video

Sau khi có dữ liệu, chỗ nào không vừa ý có thể sửa bằng tay không dùng code tùy ý

Em cảm ơn thầy ạ
Thầy và các thành viên có thể giúp em đoạn Code VBA được không ạ vì em có rất nhiều file đo và có cùng cấu trúc như vậy ạ
Em cảm ơn thầy và các thành viên trên diễn đàn nhiều ạ!

ndu96081631 · 27/7/17

baquang1984 đã viết:
Em cảm ơn thầy ạ
Thầy và các thành viên có thể giúp em đoạn Code VBA được không ạ vì em có rất nhiều file đo và có cùng cấu trúc như vậy ạ
Em cảm ơn thầy và các thành viên trên diễn đàn nhiều ạ!

Nếu làm bằng tay được thì tin rằng 90% code sẽ làm được. Với dạng này, bạn tìm các bài viết "LẤY DỮ LIỆU TỪ FILE TXT" xem. Có thể áp dụng được đấy

baquang1984 · 27/7/17

ndu96081631 đã viết:
Nếu làm bằng tay được thì tin rằng 90% code sẽ làm được. Với dạng này, bạn tìm các bài viết "LẤY DỮ LIỆU TỪ FILE TXT" xem. Có thể áp dụng được đấy

Do em cũng chỉ ứng dụng VBA vào công việc của mình và cũng đã tham khảo những Code VBA có trên diễn đàn nhưng em không biết sửa Code thế nào cho phù hợp để chạy được file của Em nên Up bài lên hỏi diễn đàn ạ.
Mong được sự giúp đỡ của các Thầy cô và các thành viên của diễn đàn!

ndu96081631 · 27/7/17

baquang1984 đã viết:
Do em cũng chỉ ứng dụng VBA vào công việc của mình và cũng đã tham khảo những Code VBA có trên diễn đàn nhưng em không biết sửa Code thế nào cho phù hợp để chạy được file của Em nên Up bài lên hỏi diễn đàn ạ.
Mong được sự giúp đỡ của các Thầy cô và các thành viên của diễn đàn!

Bạn đã thấy cách làm bằng tay qua video? Bạn cứ theo đó rồi record macro là có ngay code rồi

baquang1984 · 27/7/17

ndu96081631 đã viết:
Bạn đã thấy cách làm bằng tay qua video? Bạn cứ theo đó rồi record macro là có ngay code rồi

Vâng em cảm ơn Thầy ndu96081631 tuy nhiên khi làm theo hướng dẫn của thầy thì chương trình tổng hợp vào được một cột dữ liệu không tách được ra thành các cột tương ứng mà em không phải dân công nghệ chỉ áp dụng những Code có trên diễn đàn hoặc nhờ các thành viên giúp thôi ạ. Do vậy mong thầy và các thành viên thông cảm và giúp em ạ.
Em cảm ơn nhiều!

ndu96081631 · 27/7/17

baquang1984 đã viết:
Vâng em cảm ơn Thầy ndu96081631 tuy nhiên khi làm theo hướng dẫn của thầy thì chương trình tổng hợp vào được một cột dữ liệu không tách được ra thành các cột tương ứng mà em không phải dân công nghệ chỉ áp dụng những Code có trên diễn đàn hoặc nhờ các thành viên giúp thôi ạ. Do vậy mong thầy và các thành viên thông cảm và giúp em ạ.
Em cảm ơn nhiều!

Do bạn làm thiếu công đoạn điền dấu "¦" vào mục Other
Tôi record macro rồi thêm "mắm muối" nó ra thế này:

Mã:

Private Sub ImportTextFile(ByVal FileName As String, ByVal Target As Range, ByVal Delimiter As String)
  On Error Resume Next
  With Target.Parent.QueryTables.Add("TEXT;" & FileName, Target)
    .TextFileOtherDelimiter = Delimiter
    .Refresh BackgroundQuery:=False
  End With
End Sub
Sub Main()
  Dim vFile
  vFile = Application.GetOpenFilename("ASC File, *.ASC")
  If TypeName(vFile) = "String" Then ImportTextFile CStr(vFile), Range("A1"), "¦"
End Sub

Toàn bộ code trên bạn cho vào 1 module rồi chạy Sub Main ---> Cửa sổ chọn file hiện ra, bạn chọn vào 1 file .ASC nào đó rồi Open và... xem kết quả
Code trên chỉ mới lấy dữ liệu dạng thô! Còn lại bạn tự chỉnh sửa nhé

baquang1984 · 27/7/17

ndu96081631 đã viết:
Do bạn làm thiếu công đoạn điền dấu "¦" vào mục Other
Tôi record macro rồi thêm "mắm muối" nó ra thế này:

Mã:

Private Sub ImportTextFile(ByVal FileName As String, ByVal Target As Range, ByVal Delimiter As String) On Error Resume Next With Target.Parent.QueryTables.Add("TEXT;" & FileName, Target) .TextFileOtherDelimiter = Delimiter .Refresh BackgroundQuery:=False End With End Sub Sub Main() Dim vFile vFile = Application.GetOpenFilename("ASC File, *.ASC") If TypeName(vFile) = "String" Then ImportTextFile CStr(vFile), Range("A1"), "¦" End Sub

Toàn bộ code trên bạn cho vào 1 module rồi chạy Sub Main ---> Cửa sổ chọn file hiện ra, bạn chọn vào 1 file .ASC nào đó rồi Open và... xem kết quả
Code trên chỉ mới lấy dữ liệu dạng thô! Còn lại bạn tự chỉnh sửa nhé

Thầy ạ Em copy code của thầy nhưng chạy chương trình lấy toàn bộ dữ liệu của file em gửi kèm thầy à. Nhưng ở đây kết quả em muốn là chỉ lấy dữ liệu từ hàng số 29 trở xuống thầy ạ để tổng hợp vào biểu em gửi kèm ạ
Mong thầy sửa code giúp em cho phù hợp với kết quả thầy ạ. Em cảm ơn thầy!

ndu96081631 · 27/7/17

baquang1984 đã viết:
Thầy ạ Em copy code của thầy nhưng chạy chương trình lấy toàn bộ dữ liệu của file em gửi kèm thầy à. Nhưng ở đây kết quả em muốn là chỉ lấy dữ liệu từ hàng số 29 trở xuống thầy ạ để tổng hợp vào biểu em gửi kèm ạ
Mong thầy sửa code giúp em cho phù hợp với kết quả thầy ạ. Em cảm ơn thầy!

Lại record macro tiếp, nó ra vầy:

Mã:

Private Sub ImportTextFile(ByVal FileName As String, ByVal Target As Range, ByVal Delimiter As String)
  On Error Resume Next
  With Target.Parent.QueryTables.Add("TEXT;" & FileName, Target)
    .TextFileOtherDelimiter = Delimiter
    .Refresh BackgroundQuery:=False
  End With
End Sub
Sub Main()
  Dim vFile
  vFile = Application.GetOpenFilename("ARC File, *.ASC").
  If TypeName(vFile) = "String" Then
    ImportTextFile CStr(vFile), Range("A1"), "¦"
    Columns("A:A").Delete
    ActiveSheet.UsedRange.Cut Range("A1")
  End If
End Sub

baquang1984 · 27/7/17

ndu96081631 đã viết:

Lại record macro tiếp, nó ra vầy:

Mã:

Private Sub ImportTextFile(ByVal FileName As String, ByVal Target As Range, ByVal Delimiter As String)
  On Error Resume Next
  With Target.Parent.QueryTables.Add("TEXT;" & FileName, Target)
    .TextFileOtherDelimiter = Delimiter
    .Refresh BackgroundQuery:=False
  End With
End Sub
Sub Main()
  Dim vFile
  vFile = Application.GetOpenFilename("ARC File, *.ASC").
  If TypeName(vFile) = "String" Then
    ImportTextFile CStr(vFile), Range("A1"), "¦"
    Columns("A:A").Delete
    ActiveSheet.UsedRange.Cut Range("A1")
  End If
End Sub

Thầy ạ khi em chạy nó báo lỗi ở dùng Code này thầy ạ
vFile = Application.GetOpenFilename("ARC File, *.ASC").

ndu96081631 · 27/7/17

baquang1984 đã viết:
Thầy ạ khi em chạy nó báo lỗi ở dùng Code này thầy ạ
vFile = Application.GetOpenFilename("ARC File, *.ASC").

Chết cha! Dư dấu chấm ở sau, bạn xóa nó đi rồi thử lại nhé

Mã:

Private Sub ImportTextFile(ByVal FileName As String, ByVal Target As Range, ByVal Delimiter As String)
  On Error Resume Next
  With Target.Parent.QueryTables.Add("TEXT;" & FileName, Target)
    .TextFileOtherDelimiter = Delimiter
    .Refresh BackgroundQuery:=False
  End With
End Sub
Sub Main()
  Dim vFile
  vFile = Application.GetOpenFilename("ASC File, *.ASC")
  If TypeName(vFile) = "String" Then
    ImportTextFile CStr(vFile), Range("A1"), "¦"
    Columns("A:A").Delete
    ActiveSheet.UsedRange.Cut Range("A1")
  End If
End Sub

Khổ thế!

baquang1984 · 27/7/17

ndu96081631 đã viết:

Chết cha! Dư dấu chấm ở sau, bạn xóa nó đi rồi thử lại nhé

Mã:

Private Sub ImportTextFile(ByVal FileName As String, ByVal Target As Range, ByVal Delimiter As String)
  On Error Resume Next
  With Target.Parent.QueryTables.Add("TEXT;" & FileName, Target)
    .TextFileOtherDelimiter = Delimiter
    .Refresh BackgroundQuery:=False
  End With
End Sub
Sub Main()
  Dim vFile
  vFile = Application.GetOpenFilename("ASC File, *.ASC")
  If TypeName(vFile) = "String" Then
    ImportTextFile CStr(vFile), Range("A1"), "¦"
    Columns("A:A").Delete
    ActiveSheet.UsedRange.Cut Range("A1")
  End If
End Sub

Khổ thế!

Thầy ơi chương trình thầy viết giúp nó không tổng hợp được nhiều file cùng một lúc ạ lại làm phiền thầy sửa giúp em.
Em cảm ơn thầy

baquang1984 · 31/7/17

ndu96081631 đã viết:

Chết cha! Dư dấu chấm ở sau, bạn xóa nó đi rồi thử lại nhé

Mã:

Private Sub ImportTextFile(ByVal FileName As String, ByVal Target As Range, ByVal Delimiter As String)
  On Error Resume Next
  With Target.Parent.QueryTables.Add("TEXT;" & FileName, Target)
    .TextFileOtherDelimiter = Delimiter
    .Refresh BackgroundQuery:=False
  End With
End Sub
Sub Main()
  Dim vFile
  vFile = Application.GetOpenFilename("ASC File, *.ASC")
  If TypeName(vFile) = "String" Then
    ImportTextFile CStr(vFile), Range("A1"), "¦"
    Columns("A:A").Delete
    ActiveSheet.UsedRange.Cut Range("A1")
  End If
End Sub

Khổ thế!

Thầy Ndu ạ mong thầy và các thành viên của diễn đàn giúp đỡ em chương trình này với ạ. Code thầy viết chỉ cho phép tổng hợp một file một thầy có thể sửa giúp em để tổng hợp được nhiều file với ạ. Em cảm ơn thầy và các thành viên của diễn đàn nhiều!

chucuoi92 · 31/7/17

baquang1984 đã viết:
Thầy Ndu ạ mong thầy và các thành viên của diễn đàn giúp đỡ em chương trình này với ạ. Code thầy viết chỉ cho phép tổng hợp một file một thầy có thể sửa giúp em để tổng hợp được nhiều file với ạ. Em cảm ơn thầy và các thành viên của diễn đàn nhiều!

Bạn sửa sub main như sau:

Mã:

Sub Main()
  Dim vFile
Application.ScreenUpdating = False
    For Each vFile In Application.GetOpenFilename("ASC File, *.ASC", MultiSelect:=True)
        If TypeName(vFile) = "String" Then
          ImportTextFile CStr(vFile), Range("B65000").End(xlUp).Offset(3, -1), "¦"
        End If
  Next
  Columns("A:A").Delete
 Range("A1", Range("G65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub
'Lưu ý là chọn nhiều file nhé!

Anh NDU có thấy ngứa mắt thì sửa lại nhé!
"ẹc ẹc"

baquang1984 · 31/7/17

chucuoi92 đã viết:

Bạn sửa sub main như sau:

Mã:

Sub Main()
  Dim vFile
Application.ScreenUpdating = False
    For Each vFile In Application.GetOpenFilename("ASC File, *.ASC", MultiSelect:=True)
        If TypeName(vFile) = "String" Then
          ImportTextFile CStr(vFile), Range("B65000").End(xlUp).Offset(3, -1), "¦"
        End If
  Next
  Columns("A:A").Delete
 Range("A1", Range("G65000").End(xlUp)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub
'Lưu ý là chọn nhiều file nhé!

Anh NDU có thấy ngứa mắt thì sửa lại nhé!
"ẹc ẹc"

Em cảm ơn ạ tuy nhiên khi chạy Code thì cột PointID bị xóa mất khỏi bảng dữ liệu mong anh chucuoi92 xem giúp ạ

chucuoi92 · 31/7/17

baquang1984 đã viết:
Em cảm ơn ạ tuy nhiên khi chạy Code thì cột PointID bị xóa mất khỏi bảng dữ liệu mong anh chucuoi92 xem giúp ạ

có xóa đâu nhỉ
mình chạy thử thấy vẫn có mà, bạn xem file đính kèm xem thế nào.

baquang1984 · 31/7/17

chucuoi92 đã viết:
có xóa đâu nhỉ
mình chạy thử thấy vẫn có mà, bạn xem file đính kèm xem thế nào.

Vâng ạ tuy nhiêu là khi tổng hợp dữ liệu của những file tiếp theo thì không cần tiêu đề nữa anh có thể sửa giúp em để nhưng file sau chương trình chỉ tổng hợp dữ liệu được không ạ
PointID Backsight Foresight (St Diff) (delta H) Distance Remarks
(Station Result) (B1-B2) (F1-F2) (D Bal ) (Pt Hgt)
A1

A1 1.34178 28.18 -0.3763
1 0.96522 28.66
50 1.292 6.56
(-0.00003) (-0.04099) -0.544
-50 (+0.00002) (+0.00005) ( +0.27)
PointID Backsight Foresight (St Diff) (delta H) Distance --------
(Station Result) (B1-B2) (F1-F2) (D Bal ) --------
Start PtID --------
A1 --------

A1 1.34178 28.18 -0.5248

chucuoi92 · 31/7/17

baquang1984 đã viết:
Vâng ạ tuy nhiêu là khi tổng hợp dữ liệu của những file tiếp theo thì không cần tiêu đề nữa anh có thể sửa giúp em để nhưng file sau chương trình chỉ tổng hợp dữ liệu được không ạ
PointID Backsight Foresight (St Diff) (delta H) Distance Remarks
(Station Result) (B1-B2) (F1-F2) (D Bal ) (Pt Hgt)
PointID Backsight Foresight (St Diff) (delta H) Distance --------
(Station Result) (B1-B2) (F1-F2) (D Bal ) --------
Start PtID --------

Lần cuối nhé!

baquang1984 · 31/7/17

chucuoi92 đã viết:
Lần cuối nhé!

Em cảm ơn nhiều ạ

Tổng hợp dữ liệu từ định dạng file .ARC (1 người xem)

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

Thành viên tiêu biểu

File đính kèm

Huyền thoại GPE

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên tiêu biểu

Huyền thoại GPE

Thành viên tiêu biểu

Thành viên tiêu biểu

Thành viên lười biếng

Thành viên tiêu biểu

Thành viên lười biếng

File đính kèm

Thành viên tiêu biểu

Thành viên lười biếng

File đính kèm

Thành viên tiêu biểu

Đếm ngược thời gian