Lấy Dữ liệu từ nhiều file về file chứa Marco, Mong các Anh giúp em

alias1313 · 7/6/17

Em có rất nhiều file thu chi đăt tên là : So1, So2……So15, Em dùng 1 file TONGKET.Sheet("TINHTONG") add marco để mở các file(So1,So2,….So15) tính toán chốt lời 12 tháng rồi lấy kp về
Em chốt lời từng tháng ( = thu-chi), được kết quả add qua 1 file TONGKET
Em muốn dùng for... Next để tính tổng và lấy kết quả ra file khác ..nhưng làm hoài không được
Anh nào biết chỉ em với…….

befaint · 7/6/17

"Ca khó" thì chắc phải chờ dài cổ...

alias1313 · 7/6/17

befaint đã viết:
"Ca khó" thì chắc phải chờ dài cổ...

Hix....khó với em thôi...giúp em đi anh @befaint ....plz...

be_09 · 7/6/17

Tiêu đề Ca khó (vi phạm nội quy).
Sheet1 File So1 có ví dụ trớt qướt từng tháng có 4 con số, số thu lại nhỏ hơn số chi (làm ăn kiểu này chỉ cần 1 tháng là bán doanh nghiệp là cái chắc).

alias1313 · 7/6/17

be09 đã viết:
Tiêu đề Ca khó (vi phạm nội quy).
Sheet1 File So1 có ví dụ trớt qướt từng tháng có 4 con số, số thu lại nhỏ hơn số chi (làm ăn kiểu này chỉ cần 1 tháng là bán doanh nghiệp là cái chắc).

Hix.....cái đó ví dụ ...để giải thích yêu càu mà anh.....anh bắt thế em chịu....
Em sửa tiêu đề rồi.....anh giúp em được không anh.....

HieuCD · 7/6/17

alias1313 đã viết:
Hix.....cái đó ví dụ ...để giải thích yêu càu mà anh.....anh bắt thế em chịu....
Em sửa tiêu đề rồi.....anh giúp em được không anh.....

tiêu đề không nên có ....!!!!????
bạn thử làm tay ra kết quả gởi lên, mới tính tới việc viết code

alias1313 · 7/6/17

HieuCD đã viết:
tiêu đề không nên có ....!!!!????
bạn thử làm tay ra kết quả gởi lên, mới tính tới việc viết code

Em đã sửa tiêu đề...
Em đã up file tính bằng tay.....
Mong anh @HieuCD giúp đỡ....

HieuCD · 7/6/17

alias1313 đã viết:
Em đã sửa tiêu đề...
Em đã up file tính bằng tay.....
Mong anh @HieuCD giúp đỡ....

bạn chú ý chỉnh đúng tên file trong mảng Filename và đuôi file thực tế trong lệnh

Mã:

FileToOpen = Path & Filename(i) & ".xlsx.xlsm"

dùng tên file bài đầu

Mã:

Sub TongHop()
Dim fso As Object, FileToOpen As String, Path As String
Dim Darr(), Arr(), i As Integer, j As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Filename = Array("", "So1", "So2", "So3", "So4", "So5", "So6", "So7", "So8", "So9", "So10", "So11", "So12", "So13", "So14", "So15")
ReDim Arr(1 To UBound(Filename), 1 To 12)
Set fso = CreateObject("Scripting.FileSystemObject")
Path = ThisWorkbook.Path & "\"
For i = 1 To UBound(Filename)
  FileToOpen = Path & Filename(i) & ".xlsx.xlsm"
  If fso.FileExists(FileToOpen) Then
    Set Wb = Workbooks.Open(FileToOpen, UpdateLinks:=0)
    Darr = Wb.Sheets("Sheet1").Range("E9:AB10").Value
    For j = 1 To UBound(Darr, 2)
      Arr(i, (j + 1) / 2) = Darr(1, j) - Darr(2, j)
    Next j
    Wb.Close False
  End If
Next i
Range("I11").Resize(UBound(Filename), 12) = Arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

alias1313 · 8/6/17

HieuCD đã viết:

bạn chú ý chỉnh đúng tên file trong mảng Filename và đuôi file thực tế trong lệnh

Mã:

FileToOpen = Path & Filename(i) & ".xlsx.xlsm"

dùng tên file bài đầu

Mã:

Sub TongHop()
Dim fso As Object, FileToOpen As String, Path As String
Dim Darr(), Arr(), i As Integer, j As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Filename = Array("", "So1", "So2", "So3", "So4", "So5", "So6", "So7", "So8", "So9", "So10", "So11", "So12", "So13", "So14", "So15")
ReDim Arr(1 To UBound(Filename), 1 To 12)
Set fso = CreateObject("Scripting.FileSystemObject")
Path = ThisWorkbook.Path & "\"
For i = 1 To UBound(Filename)
  FileToOpen = Path & Filename(i) & ".xlsx.xlsm"
  If fso.FileExists(FileToOpen) Then
    Set Wb = Workbooks.Open(FileToOpen, UpdateLinks:=0)
    Darr = Wb.Sheets("Sheet1").Range("E9:AB10").Value
    For j = 1 To UBound(Darr, 2)
      Arr(i, (j + 1) / 2) = Darr(1, j) - Darr(2, j)
    Next j
    Wb.Close False
  End If
Next i
Range("I11").Resize(UBound(Filename), 12) = Arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Những câu lệnh mà anh sử dụng...thật gắn gọn và hết sức độc đáo..
Em đã chạy thử nhưng nó bị lỗi chổ vòng for..em chưa tìm ra nguyên nhân.

Anh có thể giải thích giúp em đoạn code:
"Darr(1, j) - Darr(2, j)" ( 1,2 ở đây em chưa hiểu là gì..)
Arr(i, (j + 1) / 2) = Darr(1, j) - Darr(2, j)

Cảm ơn anh @HieuCD rất nhiều....

VetMini · 8/6/17

alias1313 đã viết:
Những câu lệnh mà anh sử dụng...thật gắn gọn và hết sức độc đáo..
Em đã chạy thử nhưng nó bị lỗi chổ vòng for..em chưa tìm ra nguyên nhân.

Anh có thể giải thích giúp em đoạn code:

Nịnh phát sợ luôn. Đã không hiểu code thì độc đáo ở chỗ nào?

HieuCD · 8/6/17

alias1313 đã viết:
Những câu lệnh mà anh sử dụng...thật gắn gọn và hết sức độc đáo..
Em đã chạy thử nhưng nó bị lỗi chổ vòng for..em chưa tìm ra nguyên nhân.

Anh có thể giải thích giúp em đoạn code:
"Darr(1, j) - Darr(2, j)" ( 1,2 ở đây em chưa hiểu là gì..)
Arr(i, (j + 1) / 2) = Darr(1, j) - Darr(2, j)

Cảm ơn anh @HieuCD rất nhiều....

Darr = Wb.Sheets("Sheet1").Range("E9:AB10").Value là vùng dữ liệu có 2 dòng dòng 1 thu và dòng 2 là chi
"Darr(1, j) - Darr(2, j)": Darr(1, j) là dòng 1 cột j, Darr(2, j) là dòng 2 cột j , trừ nhau ra số tồn cột j
Darr 1 tháng có 2 cột ghi vào mảng kết quả Arr chỉ có 1 cột. nên cần qui đổi cột của Darr sang cột của Arr bằng công thức (j+1)/2
bạn chỉnh code của mình hay để nguyên xi mà bị lỗi?

alias1313 · 8/6/17

VetMini đã viết:
Nịnh phát sợ luôn. Đã không hiểu code thì độc đáo ở chỗ nào?

Hiểu chứ anh!..Nhưng hiểu chưa hết...nên em mí hỏi.....^_^....
Nhưng anh có công nhận là đoạn code rất ..hay.... không....

alias1313 · 8/6/17

HieuCD đã viết:
Darr = Wb.Sheets("Sheet1").Range("E9:AB10").Value là vùng dữ liệu có 2 dòng dòng 1 thu và dòng 2 là chi
"Darr(1, j) - Darr(2, j)": Darr(1, j) là dòng 1 cột j, Darr(2, j) là dòng 2 cột j , trừ nhau ra số tồn cột j
Darr 1 tháng có 2 cột ghi vào mảng kết quả Arr chỉ có 1 cột. nên cần qui đổi cột của Darr sang cột của Arr bằng công thức (j+1)/2
bạn chỉnh code của mình hay để nguyên xi mà bị lỗi?

Vậy có nghĩa là trong Range("E9:AB10") có hai dòng nên Darr(1, j) là dòng 1 cột j, Darr(2, j) là dòng 2 cột j
Nếu : Darr = Wb.Sheets("Sheet1").Range("E1:AB10") thì : Darr(8, j) là dòng 8 cột j, Darr(10, j) là dòng 10 cột j....có đúng không anh...

Bị sai do em chỉnh lại Darr(1, j) & Darr(2, j)....em hiểu sai 1,2 trong Darr...em quên là Range của nó chỉ có 2 hàng....^_^...Thanks anh @HieuCD nhìu nhìu.....

VetMini · 8/6/17

alias1313 đã viết:
Hiểu chứ anh!..Nhưng hiểu chưa hết...nên em mí hỏi.....^_^....
Nhưng anh có công nhận là đoạn code rất ..hay.... không....

Tôi chỉ chấm code đúng hay sai, có dễ chỉnh sửa hay không thôi.
Chuyện hay hoặc dở đối với tôi nó nằm trong thuật toán.

Trước mắt là bạn chỉnh sửa không được, thuật toán thì bạn cũng chẳng rõ. Thế thì bạn dựa vào gì để khen hay?

HieuCD · 8/6/17

alias1313 đã viết:
Vậy có nghĩa là trong Range("E9:AB10") có hai dòng nên Darr(1, j) là dòng 1 cột j, Darr(2, j) là dòng 2 cột j
Nếu : Darr = Wb.Sheets("Sheet1").Range("E1:AB10") thì : Darr(8, j) là dòng 8 cột j, Darr(10, j) là dòng 10 cột j....có đúng không anh...

Bị sai do em chỉnh lại Darr(1, j) & Darr(2, j)....em hiểu sai 1,2 trong Darr...em quên là Range của nó chỉ có 2 hàng....^_^...Thanks anh @HieuCD nhìu nhìu.....

bạn cứ lấy đúng dòng thu trừ dòng chi là được

alias1313 · 8/6/17

VetMini đã viết:
Tôi chỉ chấm code đúng hay sai, có dễ chỉnh sửa hay không thôi.
Chuyện hay hoặc dở đối với tôi nó nằm trong thuật toán.

Trước mắt là bạn chỉnh sửa không được, thuật toán thì bạn cũng chẳng rõ. Thế thì bạn dựa vào gì để khen hay?

.Anh nhận xét thế..có vội vàng quá không ..?...Mà...hìnnh như có vẻ....chúng ta đang ..lạc đề....^_^...

alias1313 · 8/6/17

HieuCD đã viết:
bạn cứ lấy đúng dòng thu trừ dòng chi là được

Em hiểu rồi.....em đã sửa lại và code chạy tốt.......Anh cho em hỏi thêm tí...

Đoạn code trên em thêm vào Arr1, Darr1:
ReDim Arr(1 To UBound(Filename), 1 To 12)
Darr1 = Wb.Sheets("Sheet1").Range("C1:AX1").Value
Arr1(i, (j + 1) / 2) = Darr1(1, j) + Darr1(1, (j + 1))

Bước tiếp theo em gán Arr và Arr1 vào chung 1 bảng kết quả, sao cho dòng Arr1 và Arr xen kẽ nhau ( bắt đầu là Arr1), em sử dụng thêm Offset
For n = 0 to 20 step 2
Range("I8").Offset(n, 0).Resize(UBound(CT_Name_Array), 24) = Arr1
Next n
For m = 1 to 21 step 2
Range("I8").Offset(m, 0).Resize(UBound(CT_Name_Array), 24) = Arr
Next n

Nhưng khi ra kết quả..bảng kết quả nó ra có khi toàn Arr1, em chỉnh lai no lai ra toàn Arr

Em giúp em nha...thương thì thương cho chót.....^_^....

Mã:

Sub TongHop()
Dim fso As Object, FileToOpen As String, Path As String
Dim Darr(), Arr(), i As Integer, j As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Filename = Array("", "So1", "So2", "So3", "So4", "So5", "So6", "So7", "So8", "So9", "So10", "So11", "So12", "So13", "So14", "So15")
ReDim Arr(1 To UBound(Filename), 1 To 12)
ReDim Arr1(1 To UBound(Filename), 1 To 12)
Set fso = CreateObject("Scripting.FileSystemObject")
Path = ThisWorkbook.Path & "\"
For i = 1 To UBound(Filename)
  FileToOpen = Path & Filename(i) & ".xlsx.xlsm"
  If fso.FileExists(FileToOpen) Then
    Set Wb = Workbooks.Open(FileToOpen, UpdateLinks:=0)
    Darr = Wb.Sheets("Sheet1").Range("E9:AB10").Value
   Darr1 = Wb.Sheets("Sheet1").Range("C1:AX1").Value
    For j = 1 To UBound(Darr, 2)
      Arr(i, (j + 1) / 2) = Darr(1, j) - Darr(2, j)
      Arr1(i, (j + 1) / 2) = Darr1(1, j) + Darr1(1, (j+1))
    Next j
    Wb.Close False
  End If
Next i
     For n= 0 to 20 step 2
Range("I8").Offset(n, 0)Resize(UBound(Filename), 12) = Arr1
           Next n
For m= 1 to 21 step 2
Range("I8").Offset(m, 0)Resize(UBound(Filename), 12) = Arr
           Next m
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

phuyen89 · 8/6/17

alias1313 đã viết:
Em hiểu rồi.....em đã sửa lại và code chạy tốt.......Anh cho em hỏi thêm tí...

Đoạn code trên em thêm vào Arr1, Darr1:
ReDim Arr(1 To UBound(Filename), 1 To 12)
Darr1 = Wb.Sheets("Sheet1").Range("C1:AX1").Value
Arr1(i, (j + 1) / 2) = Darr1(1, j) + Darr1(1, (j + 1))

Bước tiếp theo em gán Arr và Arr1 vào chung 1 bảng kết quả, sao cho dòng Arr1 và Arr xen kẽ nhau ( bắt đầu là Arr1), em sử dụng thêm Offset
For n = 0 to 20 step 2
Range("I8").Offset(n, 0).Resize(UBound(CT_Name_Array), 24) = Arr1
Next n
For m = 1 to 21 step 2
Range("I8").Offset(m, 0).Resize(UBound(CT_Name_Array), 24) = Arr
Next n

Nhưng khi ra kết quả..bảng kết quả nó ra có khi toàn Arr1, em chỉnh lai no lai ra toàn Arr

Em giúp em nha...thương thì thương cho chót.....^_^....

Sao bạn không đưa dữ liệu luôn từ đầu, mỗi lần đọc lại code, vất vả lắm bạn biết không.

alias1313 · 8/6/17

phuyen89 đã viết:
Sao bạn không đưa dữ liệu luôn từ đầu, mỗi lần đọc lại code, vất vả lắm bạn biết không.

Mình đã edit lại...cảm ơn bạn đã góp ý.....

HieuCD · 8/6/17

alias1313 đã viết:
Em hiểu rồi.....em đã sửa lại và code chạy tốt.......Anh cho em hỏi thêm tí...

Đoạn code trên em thêm vào Arr1, Darr1:
ReDim Arr(1 To UBound(Filename), 1 To 12)
Darr1 = Wb.Sheets("Sheet1").Range("C1:AX1").Value
Arr1(i, (j + 1) / 2) = Darr1(1, j) + Darr1(1, (j + 1))

Bước tiếp theo em gán Arr và Arr1 vào chung 1 bảng kết quả, sao cho dòng Arr1 và Arr xen kẽ nhau ( bắt đầu là Arr1), em sử dụng thêm Offset
For n = 0 to 20 step 2
Range("I8").Offset(n, 0).Resize(UBound(CT_Name_Array), 24) = Arr1
Next n
For m = 1 to 21 step 2
Range("I8").Offset(m, 0).Resize(UBound(CT_Name_Array), 24) = Arr
Next n

Nhưng khi ra kết quả..bảng kết quả nó ra có khi toàn Arr1, em chỉnh lai no lai ra toàn Arr

Em giúp em nha...thương thì thương cho chót.....^_^....

Mã:

Sub TongHop() Dim fso As Object, FileToOpen As String, Path As String Dim Darr(), Arr(), i As Integer, j As Integer Application.DisplayAlerts = False Application.ScreenUpdating = False Filename = Array("", "So1", "So2", "So3", "So4", "So5", "So6", "So7", "So8", "So9", "So10", "So11", "So12", "So13", "So14", "So15") ReDim Arr(1 To UBound(Filename), 1 To 12) ReDim Arr1(1 To UBound(Filename), 1 To 12) Set fso = CreateObject("Scripting.FileSystemObject") Path = ThisWorkbook.Path & "\" For i = 1 To UBound(Filename) FileToOpen = Path & Filename(i) & ".xlsx.xlsm" If fso.FileExists(FileToOpen) Then Set Wb = Workbooks.Open(FileToOpen, UpdateLinks:=0) Darr = Wb.Sheets("Sheet1").Range("E9:AB10").Value Darr1 = Wb.Sheets("Sheet1").Range("C1:AX1").Value For j = 1 To UBound(Darr, 2) Arr(i, (j + 1) / 2) = Darr(1, j) - Darr(2, j) Arr1(i, (j + 1) / 2) = Darr1(1, j) + Darr1(1, (j+1)) Next j Wb.Close False End If Next i For n= 0 to 20 step 2 Range("I8").Offset(n, 0)Resize(UBound(Filename), 12) = Arr1 Next n For m= 1 to 21 step 2 Range("I8").Offset(m, 0)Resize(UBound(Filename), 12) = Arr Next m Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

arr có tới 15 dòng, mỗi lần dán kết quả trong for là 15 dòng, trong khi đó for chỉ step 2 nên đè lên kết quả trước

Lấy Dữ liệu từ nhiều file về file chứa Marco, Mong các Anh giúp em

Thành viên hoạt động

File đính kèm

|||||||||||||

Thành viên hoạt động

Biên Hòa, Đồng Nai

Thành viên hoạt động

Chuyên gia GPE

Thành viên hoạt động

File đính kèm

Chuyên gia GPE

Thành viên hoạt động

Ăn cùng góc phố

Chuyên gia GPE

Thành viên hoạt động

Thành viên hoạt động

Ăn cùng góc phố

Chuyên gia GPE

Thành viên hoạt động

Thành viên hoạt động

Thành viên tích cực

Thành viên hoạt động

Chuyên gia GPE

Facebook

Group