Chủ đề: Hợp nhất nhiều File vào 1 file
-
07-30-2014, 07:09 AM #21
Junior Member
- Ngày tham gia
- Nov 2015
- Bài viết
- 0
Ðề: Hợp nhất nhiều File vào 1 file
Cảm ơn bác win, em gà mờ ko hiểu được Macro ạ. Bác hướng dẫn chi tiết hơn giúp em k?
-
11-11-2014, 07:54 PM #22
Junior Member
- Ngày tham gia
- Nov 2015
- Bài viết
- 3
Dear Anh/ Chị
Em đang cần gom KPI của phòng từ đầu năm đến giờ, hiên nay KPI mọi người đang để mỗi ngày một file excel giờ em muốn gom các file chứa sheet đó thành một. Em đã tải file này về và làm theo hướng dẫn bên dưới nhưng vẫn chưa hiểu lắm ạ. Nhờ anh giải đáp giúp em vì em cũng ko biết gì về marco đâu ạ, đang làm máy móc theo hướng dẫn của mọi người
Trên file tải về của Anh Beo09 em đã làm theo chú ý phía dưới nhưng vẫn ko được. File em tải lên đây thì bị lỗi ko được. Cám ơn Anh/ Chị
https://app.box.com/s/5s4gswnwwetojab7gbqy
-
12-12-2014, 03:50 PM #23
Junior Member
- Ngày tham gia
- Aug 2015
- Bài viết
- 0
Em có làm cái video minh hoạ cho mọi người xem
Hướng dẫn VBA 11 Consolidate (copy) dữ liệu từ nhiều báo cáo vào 1 báo cáo tổng không mở báo cáo con
-
03-23-2015, 09:10 PM #24
Silver member
- Ngày tham gia
- Mar 2016
- Bài viết
- 0
Gửi bởi be09
-
03-23-2015, 09:51 PM #25
Junior Member
- Ngày tham gia
- Aug 2015
- Bài viết
- 0
Gửi bởi be09
tạo 2 module:
#1: Module CommonFunctions
(code)
===========================
Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
' If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
Sub CopyValuesFromAClosedWorkbook(fPath As String, _
fName As String, srcSheet As String, srcRange As String, desSheet As String, desRange As String)
With Worksheets(desSheet).Range(desRange)
.FormulaArray = "='" & fPath & "\[" & fName & "]" _
& srcSheet & "'!" & srcRange
.Value = .Value
End With
End Sub
Public Function ColumnNumberToLetter(ByVal lngNumber As Long) As String
ColumnNumberToLetter = Split(ThisWorkbook.Worksheets(1).Columns(lngNumber ).Address, ":")(0)
End Function
Public Function ColumnLetterToNumber(ByVal strLetter As String) As Long
ColumnLetterToNumber = ThisWorkbook.Worksheets(1).Columns(strLetter).Colu mn
End Function
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
sItem = ""
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Chon thu muc chua file du lieu cac Phong"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Sub ProcessRange(sPath As String, sFile As String, sSheet As String, _
minCol As String, minRow As String, _
maxCol As String, maxRow As String, tempCol As String)
Dim col As Integer
Dim row As Integer
Dim sRange As String
Dim tRange As String
Dim tempRange As String
sRange = minCol & minRow & ":" & maxCol & maxRow
tRange = tempCol & minRow & ":" & _
ColumnNumberToLetter(ColumnLetterToNumber(maxCol) - ColumnLetterToNumber(minCol) + ColumnLetterToNumber(tempCol)) & _
maxRow
Call CopyValuesFromAClosedWorkbook(sPath, sFile, sSheet, sRange, sSheet, tRange)
For col = ColumnLetterToNumber(minCol) To ColumnLetterToNumber(maxCol)
For row = minRow To maxRow
sRange = ColumnNumberToLetter(col) & row
tempRange = ColumnNumberToLetter(ColumnLetterToNumber(tempCol) + col - ColumnLetterToNumber(minCol)) & row
iTemp = ThisWorkbook.Worksheets(sSheet).Range(sRange).Valu e
iTemp = iTemp + ThisWorkbook.Worksheets(sSheet).Range(tempRange).V alue
ThisWorkbook.Worksheets(sSheet).Range(sRange).Valu e = iTemp
Next
Next
ThisWorkbook.Worksheets(sSheet).Range(tRange).Clea rContents
End Sub
================================================== =============
#2: Main
(code)
===========================
Sub RealCapNhat(sPath As String, sheetName As String, colMax As String, cellMonth As String, cellYear As String, _
Optional cnKQ As Boolean)
Dim iCount As Integer
Dim sFile As String
Dim sRange As String
Dim i As Integer
Dim bOthersUpdated As Boolean
Password = "0986886338"
ThisWorkbook.Worksheets(sheetName).Unprotect Password
iCount = 0
If sPath <> "" Then
'Xoa het cac dong cu
'Clear 10 dong dau
ThisWorkbook.Worksheets(sheetName).Range("A8:" & colMax & "17").ClearContents
'Xoa cac dong tiep theo
Do While ThisWorkbook.Worksheets(sheetName).Range("A18").Va lue <> "END"
ThisWorkbook.Worksheets(sheetName).Rows(18-).EntireRow.Delete
Loop
ThisWorkbook.Worksheets(sheetName).Range("G2").Cle arContents
sMask = sPath & "\*.xls"
sFile = Dir(sMask)
bOthersUpdated = False
Do While Len(sFile) > 0
'================================================= =============================
'Xu ly doi voi tung file du lieu Xa
iTemp = ThisWorkbook.Worksheets(sheetName).Range("G2").Val ue
iTemp = iTemp + GetInfoFromClosedFile(sPath, sFile, sheetName, "B18")
ThisWorkbook.Worksheets(sheetName).Range("G2").Val ue = iTemp
If bOthersUpdated <> True Then
'Tinh, Huyen
ThisWorkbook.Worksheets(sheetName).Range("C1").Val ue = GetInfoFromClosedFile(sPath, sFile, sheetName, "C1")
ThisWorkbook.Worksheets(sheetName).Range("C2").Val ue = GetInfoFromClosedFile(sPath, sFile, sheetName, "C2")
'Thoi diem
ThisWorkbook.Worksheets(sheetName).Range(cellYear) .Value = GetInfoFromClosedFile(sPath, sFile, sheetName, cellYear)
ThisWorkbook.Worksheets(sheetName).Range(cellMonth ).Value = GetInfoFromClosedFile(sPath, sFile, sheetName, cellMonth)
bOthersUpdated = True
End If
'Insert them dong neu can thiet
If iCount >= 10 Then
ThisWorkbook.Worksheets(sheetName).Rows(iCount + 7).EntireRow.Insert
ThisWorkbook.Worksheets(sheetName).Range("A" & (iCount + 7) & ":" & colMax & (iCount + 7)).Value = _
ThisWorkbook.Worksheets(sheetName).Range("A" & (iCount + 8-) & ":" & colMax & (iCount + 8-)).Value
End If
'STT
sRange = "A" & (8 + iCount)
ThisWorkbook.Worksheets(sheetName).Range(sRange).V alue = iCount + 1
'Ten xa
sRange = "B" & (8 + iCount)
ThisWorkbook.Worksheets(sheetName).Range(sRange).V alue = GetInfoFromClosedFile(sPath, sFile, sheetName, "C3")
'Du lieu
sRange = "C" & (8 + iCount) & ":" & colMax & (8 + iCount)
Call CopyValuesFromAClosedWorkbook(sPath, sFile, sheetName, "C18:" & colMax & "18", sheetName, sRange)
'Ket qua
If cnKQ Then
sRange = "AC" & (8 + iCount)
ThisWorkbook.Worksheets(sheetName).Range(sRange).V alue = GetInfoFromClosedFile(sPath, sFile, sheetName, "C23")
End If
'================================================= =============================
iCount = iCount + 1
sFile = Dir()
Loop
End If
If cnKQ Then
If iCount > 10 Then
iCountR = iCount
Else
iCountR = 10
End If
sRange = "D" & (17 + iCountR)
ThisWorkbook.Worksheets(sheetName).Range(sRange).V alue = _
ThisWorkbook.Worksheets("CSVC").Range("G2").Value
End If
ThisWorkbook.Worksheets(sheetName).Protect Password, True, True, True
End Sub
Sub CapNhatDoTuoi(sPath As String)
Dim iCount As Integer
Dim iTemp As Integer
Dim sFile As String
Dim i As Integer
Dim sheetName As String
sheetName = "DoTuoi"
Password = "0986886338"
ThisWorkbook.Worksheets(sheetName).Unprotect Password
iCount = 0
If sPath <> "" Then
'Clear data
ThisWorkbook.Worksheets(sheetName).Range("F6:Q59") .ClearContents
sMask = sPath & "\*.xls"
sFile = Dir(sMask)
Do While Len(sFile) > 0
'Xu ly doi voi tung file du lieu Phong
Call ProcessRange(sPath, sFile, sheetName, "F", "6", "Q", "59", "R")
iCount = iCount + 1
sFile = Dir()
Loop
End If
ThisWorkbook.Worksheets(sheetName).Protect Password, True, True, True
End Sub
Sub CapNhatKhac(sPath As String)
Dim iCountT(1 To 4) As Integer
Dim i As Integer
Dim sFile As String
Dim sRange As String
Dim iCount As Integer
Dim sheetName As String
sheetName = "GV"
For i = 1 To 4
iCountT(i) = 0
Next i
Password = "0986886338"
ThisWorkbook.Worksheets(sheetName).Unprotect Password
iCount = 0
If sPath <> "" Then
sMask = sPath & "\*.xls"
sFile = Dir(sMask)
Do While Len(sFile) > 0
'Xu ly doi voi tung file du lieu Phong
sTemp = GetInfoFromClosedFile(sPath, sFile, sheetName, "C24")
Select Case sTemp
Case "PC"
iCountT(1) = iCountT(1) + 1
Case "M1"
iCountT(2) = iCountT(2) + 1
Case "M2"
iCountT(3) = iCountT(3) + 1
Case "KO"
iCountT(4) = iCountT(4) + 1
End Select
sFile = Dir()
iCount = iCount + 1
Loop
End If
'Clear data
ThisWorkbook.Worksheets(sheetName).Range("D" & (iCount + 13) & "" & (iCount + 16)).ClearContents
'Set data
ThisWorkbook.Worksheets(sheetName).Range("D" & (iCount + 13)).Value = iCountT(1)
ThisWorkbook.Worksheets(sheetName).Range("D" & (iCount + 14)).Value = iCountT(2)
ThisWorkbook.Worksheets(sheetName).Range("D" & (iCount + 15)).Value = iCountT(3)
ThisWorkbook.Worksheets(sheetName).Range("D" & (iCount + 16)).Value = iCountT(4)
ThisWorkbook.Worksheets(sheetName).Protect Password, True, True, True
End Sub
Sub CapNhat()
Dim sPath As String
sPath = GetFolder(ThisWorkbook.Path)
If sPath <> "" Then
Call RealCapNhat(sPath, "CSVC", "AI", "T2", "W2")
Call RealCapNhat(sPath, "GV", "AC", "R2", "T2", True)
Call CapNhatDoTuoi(sPath)
MsgBox ("Da cap nhat xong")
End If
End Sub
-
03-26-2015, 08:39 PM #26
Junior Member
- Ngày tham gia
- Aug 2015
- Bài viết
- 0
Tổng hợp các file excel qua mạng nội bộ hàng tháng
em muốn tổng hợp các sheet của nhieu excel (sheet1 của worksheet1, sheet1 của worksheet2,...) qua mạng nội bộ hàng tháng, sau đó em sẽ tổng hợp lại thành 01 sheetsum từ nhiều sheet (sheet1, sheet2,...) đã tổng hợp)
cụ thể: bộ phận có 1 file excel gồm nhiều tháng (mỗi tháng là một sheet)
vd: máy 1 có file TCHC (trong file TCHC có các sheet: T01, T02,…), máy 2 có file TCKT (trong file TCKT có các sheet: T01, T02,…), máy 3 có file KHTH (trong file KHTH có các sheet: T01, T02,..)
hàng tháng em sẽ tổng hợp tất các các sheet của tháng đó ở tất cả các bộ phận vào 01 file chung (file này gồm 01 sheet tổng hợp và sheet1 của tất cả các bộ phận) chỉ bằng 01 click vào nút tổng hợp.
đồng thời không cho xoá, chỉnh sửa sau khi em đã tổng hợp. ví dụ đến 5 giờ chiều ngày cuối tháng em sẽ tổng hợp, và sẽ khoa lại sau khi tổng hợp, khoa nào muốn chỉnh sửa thì liên hệ em mở ra cho chỉnh sửa.
anh chị giúp dùm em, em cảm ơn nhiều!!!
ví dụ:
-
06-18-2015, 11:04 PM #27
Junior Member
- Ngày tham gia
- Nov 2015
- Bài viết
- 3
Mọi người ơi nếu sheet của em chứa cả mục gộp ô và tách ô thì macro tổng hợp được khôngna vậy?? có cách nào tổng hợp dữ liêu từ nhiều sheet giông nhau(có mục gộp tách ô) ko ạ
-
01-03-2016, 05:35 PM #28
Junior Member
- Ngày tham gia
- Aug 2015
- Bài viết
- 0
Em chào mọi người!
Tiếp theo chủ đề hấp dẫn này em có một tình huống xuất phát từ công việc cần xử lý như sau, mong mọi người giúp đỡ.
Em làm ở kho sách, hiện tại em có một file tổng hợp về số tồn kho gọi là TONKHO (tính đến 1/1/2016). Hàng ngày kho em sẽ làm các phiếu xuất hàng gọi là PX1, PX2, PX3..., và đồng thời là nhập những đầu sách mới vào là các PN1, PN2, PN3... Số PN và PX có thể lên vài chục file excel, mỗi file chỉ có một sheet thôi, các danh mục sách cũng khác nhau. Nhiệm vụ của em là cập nhật số liệu tồn kho hiện tại sau mỗi ngày để làm báo cáo theo cái lựa chọn như: tủ sách, tựa sách, giá thành, khách hàng.... Mong mọi người giúp đỡ.
Ps: PN và PX có cấu trúc giống nhau ạ
-
01-04-2016, 03:33 PM #29
Junior Member
- Ngày tham gia
- Nov 2015
- Bài viết
- 0
Gửi bởi BuiSu
1/ 1 Sheet theo dõi nhập kho (dùng sheet này tra cứu với Sheet xuất kho để biết loại sách còn tồn kho).
2/ 1 Sheet theo dõi xuất kho.
3/ 1 Sheet vừa làm phiếu nhập, phiếu xuất (chỉ 1 phiếu, dùng Validation để thay đổi loại phiếu), mỗi loại phiếu có 1 cái nút, nếu in phiếu xong tùy loại mà nhấn nút nhập (lưu dữ liệu vào Sheet nhập kho)hoặc nhấn nút xuất (lưu dữ liệu vào Sheet xuất kho).
Kể với bác sĩ, anh M. cho biết bữa qua là sinh nhật của mình nên có đi ăn tối, rồi trở về nhà quan hệ tình dục với vợ. Trong quá trình quan hệ , vợ anh dùng miệng "tác động" nhiều vào vùng tinh hoàn....
Hy hữu. Anh chàng suýt mất tinh hoàn vì chơi bằng miệng với vợ