Ghi số liệu từ 1 sheets của excell vào 1file txt đã có sẵn (1 người xem)

[thuannhpecc2]

Chào cả nhà!!
Nhờ các anh/chị giúp em lấy dữ liệu của 1 sheets định trước ghi vào 1 file txt đã có sẵn, dữ liệu ghi vào bắt đầu từ vị trí định trước ( vị trí này thay đổi theo từng kết quả tính ra)

VD: em có 2 file 1 file Excell là xuatdl và 1 file la DG110
Trong file TraT3D xóa các dòng từ sau dòng
"Tong so thanh 2 nut ....." đến dòng "Tong so Nhom Vat lieu..." ( các dấu ... là dữ liệu sẽ thay đổi theo kết quả tính toán ra), sau đấy ghi dữ liệu từ sheets TraT3d của file xuatdl từ dòng thứ 2, cột 2 đến hết sheest sau dòng có ký hiệu là "Tong so Thanh 2 nut...".
Nói vắn tắt là thay thế các dòng trong file xuatdl từ sau dòng "Tong so thanh 2 nut ....." đến dòng "Tong so Nhom Vat lieu..." bằng dữ liệu từ sheets " TraT3d" lấy từ dòng số 2 cột số 2 trở đi ( không lấy dòng 1 và cột 1).
Sẵn các anh chị giúp kiểm tra số dòng xóa và số dòng cần thay thế vào phải bằng nhau, nếu không bằng nhau thì có dòng cảnh báo không cho thay thế để kiểm tra. ( cái này quan trọng vì không có nó lỡ tay nhấn nút 1 phát là phải làm lại mất ít nhất 45 phút, trong các file gởi đi em đã lượt bớt đi rồi).

Cảm ơn các anh/chị

 

[ndu96081631]

Chào cả nhà!!
Nhờ các anh/chị giúp em lấy dữ liệu của 1 sheets định trước ghi vào 1 file txt đã có sẵn, dữ liệu ghi vào bắt đầu từ vị trí định trước ( vị trí này thay đổi theo từng kết quả tính ra)

VD: em có 2 file 1 file Excell là xuatdl và 1 file la DG110
Trong file TraT3D xóa các dòng từ sau dòng
"Tong so thanh 2 nut ....." đến dòng "Tong so Nhom Vat lieu..." ( các dấu ... là dữ liệu sẽ thay đổi theo kết quả tính toán ra), sau đấy ghi dữ liệu từ sheets TraT3d của file xuatdl từ dòng thứ 2, cột 2 đến hết sheest sau dòng có ký hiệu là "Tong so Thanh 2 nut...".
Nói vắn tắt là thay thế các dòng trong file xuatdl từ sau dòng "Tong so thanh 2 nut ....." đến dòng "Tong so Nhom Vat lieu..." bằng dữ liệu từ sheets " TraT3d" lấy từ dòng số 2 cột số 2 trở đi ( không lấy dòng 1 và cột 1).
Sẵn các anh chị giúp kiểm tra số dòng xóa và số dòng cần thay thế vào phải bằng nhau, nếu không bằng nhau thì có dòng cảnh báo không cho thay thế để kiểm tra. ( cái này quan trọng vì không có nó lỡ tay nhấn nút 1 phát là phải làm lại mất ít nhất 45 phút, trong các file gởi đi em đã lượt bớt đi rồi).

Cảm ơn các anh/chị

Với cách hỏi thế này + file đính kèm thế này (sơ sài) ---> Bảo đảm sẽ chẳng có ai giúp

 

[thuannhpecc2]

Với cách hỏi thế này + file đính kèm thế này (sơ sài) ---> Bảo đảm sẽ chẳng có ai giúp

Không hiểu sơ sài như thế nào nhỉ, file đã up lên và ghi rõ rồi.
----- em ghi lại nhé!
trong file DG110.txt có cấu trúc
-----------------------------------------------
Cot do goc
Tong so Nut = 307
1 -2.39993 -2.39993 0.00000 1 1 1 1 1 1 1 1
2 2.39993 -2.39993 0.00000 1 1 1 1 1 1 1 2
3 -2.39993 2.39993 0.00000 1 1 1 1 1 1 1 3
4 2.39993 2.39993 0.00000 1 1 1 1 1 1 1 4
5 -1.19997 -2.32936 1.05881 0 0 0 0 0 0 1 5
Tong so Thanh 2 nut = 09 08
1 1 5 0 1 7 0 0 0
2 2 6 0 1 7 0 0 0
3 1 7 0 1 7 0 0 0
4 2 8 0 1 7 0 0 0
5 3 9 0 1 7 0 0 0
6 4 10 0 1 7 0 0 0
7 3 11 0 1 7 0 0 0
8 4 12 0 1 7 0 0 0
9 1 13 0 2 22 0 0 0
Tong so Nhom Vat lieu = 2
1 21000000.0000 0.3000 7.8500 10 1 1.1000 2300.0000
2 21000000.0000 0.3000 7.8500 10 1 1.1000 3400.0000
Tong so Nhom hinh hoc = 30
-----------------------------
Sheets excel có du lieu
----------------
ptu ndau ncuoi nutk loaivl ltdien lnen llket hs
[ 1] 1 1 5 0 1 2 0 0 0
[ 1] 2 2 6 0 1 3 0 0 0
[ 1] 3 1 7 0 1 12 0 0 0
[ 1] 4 2 8 0 1 3 0 0 0
[ 1] 5 3 9 0 1 5 0 0 0
[ 1] 6 4 10 0 1 7 0 0 0
[ 1] 7 3 11 0 1 9 0 0 0
[ 1] 8 4 12 0 1 11 0 0 0
[ 2] 9 1 13 0 2 15 0 0 0


--------------------------
em muốn ghi đè dữ liệu trong sheets TraT3D (phần tô đậm, không lấy cột 1 và hàng 1) vào vùng dữ liệu trên (phần tô đậm) của file DG110 trên và có kiểm tra điều kiện số hàng cần chèn vào phải bằng số hàng cần xóa.
====> sau khi chèn vào file DG110.txt sẽ như sau:
------
Cot do goc
Tong so Nut = 307
1 -2.39993 -2.39993 0.00000 1 1 1 1 1 1 1 1
2 2.39993 -2.39993 0.00000 1 1 1 1 1 1 1 2
3 -2.39993 2.39993 0.00000 1 1 1 1 1 1 1 3
4 2.39993 2.39993 0.00000 1 1 1 1 1 1 1 4
5 -1.19997 -2.32936 1.05881 0 0 0 0 0 0 1 5
Tong so Thanh 2 nut = 09 08
1 1 5 0 1 2 0 0 0
2 2 6 0 1 3 0 0 0
3 1 7 0 1 12 0 0 0
4 2 8 0 1 3 0 0 0
5 3 9 0 1 5 0 0 0
6 4 10 0 1 7 0 0 0
7 3 11 0 1 9 0 0 0
8 4 12 0 1 11 0 0 0
9 1 13 0 2 15 0 0 0
Tong so Nhom Vat lieu = 2
1 21000000.0000 0.3000 7.8500 10 1 1.1000 2300.0000
2 21000000.0000 0.3000 7.8500 10 1 1.1000 3400.0000
Tong so Nhom hinh hoc = 30
----------------
Nhờ anh/chị giúp đỡ.

 

[thuannhpecc2]

em goi lai 2 file da luoc bo bot

Em gởi lại 2 file đã lượt bớt cho dễ nhìn

 

[thuannhpecc2]

Có bác nào rành vụ này giúp em với.!!!
Cảm ơn nhiều!!!

 

[ndu96081631]

Có bác nào rành vụ này giúp em với.!!!
Cảm ơn nhiều!!!

Bài này cũng không đến nỗi khó nhưng sao chẳng thấy ai vào cuộc nhỉ?
Làm vầy đi:

Sub Main()
  Dim txtFile As String, strAll As String
  Dim str1 As String, str2 As String, str3 As String
  Dim lPos1 As Long, lPos2 As Long, lR As Long, lC As Long
  Dim wks As Worksheet, rng As Range, sArray
  On Error Resume Next
  txtFile = ThisWorkbook.Path & "\DG110.txt"
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(txtFile) Then
      With .OpenTextFile(txtFile, 1)
        strAll = .ReadAll: .Close
      End With
      lPos1 = InStr(1, strAll, "Tong so Thanh 2 nut =", vbTextCompare)
      lPos1 = InStr(lPos1, strAll, vbCrLf, vbTextCompare)
      lPos2 = InStr(1, strAll, "Tong so Nhom Vat lieu =", vbTextCompare)
      str1 = Mid(strAll, 1, lPos1)
      str2 = Mid(strAll, lPos2)
      Set wks = ThisWorkbook.Worksheets("Tra T3D")
      Set rng = wks.Range(wks.[B60000].End(xlUp), wks.[IV2].End(xlToLeft))
      If rng.Count > 1 Then
        sArray = rng.Value
        ReDim tmp(1 To UBound(sArray, 2))
        ReDim Arr(1 To UBound(sArray, 1))
        For lR = 1 To UBound(sArray, 1)
          For lC = 1 To UBound(sArray, 2)
            tmp(lC) = sArray(lR, lC)
          Next
          Arr(lR) = Join(tmp, vbTab)
        Next
        str3 = Join(Arr, vbCrLf)
        strAll = str1 & vbCrLf & str3 & vbCrLf & str2
        With .OpenTextFile(txtFile, 2)
          .Write strAll: .Close
        End With
        MsgBox "Done!"
      End If
    End If
  End With
End Sub

Tải file về, giải nén, mở file Excel lên (và Enable Macros). Xong, bấm nút 1 phát để gọi Sub Main rồi chờ, khi nào nhận được MsgBox thì mở file txt ra kiểm tra kết quả

 

[thuannhpecc2]

Bài này cũng không đến nỗi khó nhưng sao chẳng thấy ai vào cuộc nhỉ?
Làm vầy đi:

Sub Main()
  Dim txtFile As String, strAll As String
  Dim str1 As String, str2 As String, str3 As String
  Dim lPos1 As Long, lPos2 As Long, lR As Long, lC As Long
  Dim wks As Worksheet, rng As Range, sArray
  On Error Resume Next
  txtFile = ThisWorkbook.Path & "\DG110.txt"
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(txtFile) Then
      With .OpenTextFile(txtFile, 1)
        strAll = .ReadAll: .Close
      End With
      lPos1 = InStr(1, strAll, "Tong so Thanh 2 nut =", vbTextCompare)
      lPos1 = InStr(lPos1, strAll, vbCrLf, vbTextCompare)
      lPos2 = InStr(1, strAll, "Tong so Nhom Vat lieu =", vbTextCompare)
      str1 = Mid(strAll, 1, lPos1)
      str2 = Mid(strAll, lPos2)
      Set wks = ThisWorkbook.Worksheets("Tra T3D")
      Set rng = wks.Range(wks.[B60000].End(xlUp), wks.[IV2].End(xlToLeft))
      If rng.Count > 1 Then
        sArray = rng.Value
        ReDim tmp(1 To UBound(sArray, 2))
        ReDim Arr(1 To UBound(sArray, 1))
        For lR = 1 To UBound(sArray, 1)
          For lC = 1 To UBound(sArray, 2)
            tmp(lC) = sArray(lR, lC)
          Next
          Arr(lR) = Join(tmp, vbTab)
        Next
        str3 = Join(Arr, vbCrLf)
        strAll = str1 & vbCrLf & str3 & vbCrLf & str2
        With .OpenTextFile(txtFile, 2)
          .Write strAll: .Close
        End With
        MsgBox "Done!"
      End If
    End If
  End With
End Sub

Tải file về, giải nén, mở file Excel lên (và Enable Macros). Xong, bấm nút 1 phát để gọi Sub Main rồi chờ, khi nào nhận được MsgBox thì mở file txt ra kiểm tra kết quả

Em cảm ơn bác nhiều, em liểm tra xem sẽ báo lại cho bác.
Một lần nữa xin chân thành cảm ơn!!!

 

[ndu96081631]

Mình cài tiến thêm 1 bước nữa cho chắc:

Sub Main()
  Dim vFile, txtFile As String, strAll As String
  Dim str1 As String, str2 As String, str3 As String
  Dim lPos1 As Long, lPos3 As Long, lR As Long, lC As Long
  Dim wks As Worksheet, rng As Range, sArray, bChk As Boolean
  On Error Resume Next
  vFile = Application.GetOpenFilename("Text File, *.txt", , "Select a text file", "ABC", False)
  If TypeName(vFile) = "String" Then
    txtFile = CStr(vFile)
    With CreateObject("Scripting.FileSystemObject")
      With .OpenTextFile(txtFile, 1): strAll = .ReadAll: .Close: End With
      
      lPos1 = InStr(1, strAll, "Tong so Thanh 2 nut =", vbTextCompare)
      lPos1 = InStr(lPos1, strAll, vbCrLf, vbTextCompare) - 1
      lPos3 = InStr(1, strAll, "Tong so Nhom Vat lieu =", vbTextCompare)
      If lPos3 > lPos1 Then
        If lPos1 * lPos3 > 0 Then
          str1 = Mid(strAll, 1, lPos1)
          str3 = Mid(strAll, lPos3)
          Set wks = ThisWorkbook.Worksheets("Tra T3D")
          Set rng = wks.Range(wks.[B60000].End(xlUp), wks.[IV2].End(xlToLeft))
          str2 = Table2TxtFormat(rng)
          If Len(str2) Then
            strAll = str1 & vbCrLf & str2 & vbCrLf & str3
            With .OpenTextFile(txtFile, 2): .Write strAll: .Close: End With
            MsgBox "Da cap nhat du lieu moi vào file '" & .GetFile(txtFile).Name & "'"
            bChk = True
          End If
        End If
      End If
    End With
  End If
  If bChk = False Then MsgBox "Ban chua chon file txt hoac không tìm thay du lieu phù hop trong file txt"
End Sub

Function Table2TxtFormat(ByVal Table As Range) As String
  Dim tmp As String
  On Error Resume Next
  Table.Copy
  With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    tmp = .GetText
  End With
  Application.CutCopyMode = 0
  If Len(tmp) Then Table2TxtFormat = tmp
End Function

phòng các trường hợp:
- File txt không nằm cùng thư mục với file Excel
- File txt không có cấu trúc giống với cái ta cần (sẽ nạp tầm bậy)
vân vân

 

[thuannhpecc2]

Cảm ơn bác, code chạy ok rồi.
Sẵn bác cho em hỏi có sách nào chỉ dẫn cú pháp câu lệnh không, em có biết sơ một số lệnh đơn giản như khi học pascal can bản. đọc dữ liệu của bác làm không hiểu câu lệnh nên không thể học hỏi được.
Cảm ơn bác.