Nhờ check hàm VBA

Liên hệ QC
Status
Không mở trả lời sau này.
8

881516

Thành viên chính thức
Tham gia
8/6/16
Bài viết
80
Được thích
6
Nội dung của hàm này như sau ạ:
Lấy dữ liệu từ các ô (E4, I6, P6, G8, H23, D31, K36, P36, K37, P37, U35, J41, J45, P45, J45, AB70, H68, H69)
trong các file 1,2,3 .... (công thức chỉ dài ở đoạn này)
Sắp xếp vào các ô ở 1 file mới

A2, B2, C2, D2, E2 ...
A3, B3, C3, D3, E3 ...
....

Em có nhờ 1 người làm hộ công thức này, nhưng ko hiểu sao các ô K37, P37, và H68 H69 ko lấy đc dữ liệu để nhập vào. Nếu xóa P36, K36 đi thì K37, P37 lại nhập đc
Vậy nhờ anh chị kiểm tra giúp em ạ


Sub test()
Dim FolderPath As String, FileName As String, strFileTarget As String
Dim wb As Excel.Workbook
Dim i As Integer, lastRow As Integer
Dim rngCopy As Range

FolderPath = Range("A1").Value & "\" 'Duong dan thu muc do tim
FileName = Dir(FolderPath & "*.xls*") 'Tim trong thu muc tat ca cac file *.xls*
strFileTarget = "IMEX - Hung.xlsm" 'Ten file macro chay

Set FSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
If FSO.FolderExists(FolderPath) Then

Do While FileName <> ""
If FileName <> strFileTarget Then

On Error Resume Next
Set wb = Workbooks.Open(FolderPath & FileName)
If Err.Number <> 0 Then: MsgBox ("Unable to open file " & FileName)
On Error GoTo 0
lastRow = Workbooks(strFileTarget).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row


Set E4 = Workbooks(FileName).Worksheets(1).Range("E4"): Set I6 = Workbooks(FileName).Worksheets(1).Range("I6")
Set P6 = Workbooks(FileName).Worksheets(1).Range("P6"): Set G8 = Workbooks(FileName).Worksheets(1).Range("G8")
Set H23 = Workbooks(FileName).Worksheets(1).Range("H23"): Set D31 = Workbooks(FileName).Worksheets(1).Range("D31")
Set K36 = Workbooks(FileName).Worksheets(1).Range("K36"): Set P36 = Workbooks(FileName).Worksheets(1).Range("P36")
Set K37 = Workbooks(FileName).Worksheets(1).Range("K37"): Set P37 = Workbooks(FileName).Worksheets(1).Range("P37")
Set U35 = Workbooks(FileName).Worksheets(1).Range("U35"): Set J41 = Workbooks(FileName).Worksheets(1).Range("J41")
Set J45 = Workbooks(FileName).Worksheets(1).Range("J45"): Set P45 = Workbooks(FileName).Worksheets(1).Range("P45")
Set J45 = Workbooks(FileName).Worksheets(1).Range("J45"): Set AB70 = Workbooks(FileName).Worksheets(1).Range("AB70")
Set H68 = Workbooks(FileName).Worksheets(1).Range("H68"): Set H69 = Workbooks(FileName).Worksheets(1).Range("H69")
Set rngCopy = Union(E4, I6, P6, G8, H23, D31, K36, P36, K37, P37, U35, J41, J45, P45, J45, AB70, H68, H69)

For i = 1 To rngCopy.Areas.Count: Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, i).Value = rngCopy.Areas(i).Value: Next

Application.Wait (Now + TimeValue("0:00:01"))
Workbooks(FileName).Close


End If

FileName = Dir
Loop

Else
MsgBox folder & "Specified Folder Not Found", vbInformation, "Not Found!"
End If
MsgBox ("Well Done!")
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
e edit lại chính xác ạ
 
ai giúp e với :(
 
Để đơn giản tôi hỏi
1. Số liệu nằm trong các file 1,2,3 .... và đều có cùng vị trí là các ô (E4, I6, P6, G8, H23, D31, K36, P36, K37, P37, U35, J41, J45, P45, J45, AB70, H68, H69)? (đúng hay sai, sai thì chỉ rõ ra)
Thêm nữa: Các file có cùng trên 1 thư mục không.

2. Sắp xếp vào các ô ở 1 file mới
A1, B1, C1, D1, E1 ...
A2, B2, C2, D2, E2 ...

thì toàn bộ các ô (E4, I6, P6, G8, H23, D31, K36, P36, K37, P37, U35, J41, J45, P45, J45, AB70, H68, H69) sẽ được xếp lần lượt thành 1 hàng thì hàng 1 là của file 1, hàng 2 là của file 2... đúng hay sai.

3. Bạn viết "Em có nhờ 1 người làm hộ công thức này..."
Đây kg phải là công thức và hàm là một chương trình con
 
haonlh đã viết:
Để đơn giản tôi hỏi
1. Số liệu nằm trong các file 1,2,3 .... và đều có cùng vị trí là các ô (E4, I6, P6, G8, H23, D31, K36, P36, K37, P37, U35, J41, J45, P45, J45, AB70, H68, H69)? (đúng hay sai, sai thì chỉ rõ ra)
Nhấp chuột vào đây để mở rộng...
Hi bạn. Mình mong đc sự giúp đỡ
1. Các file cần lấy dữ liệu nằm trong 1 thư mục (có đường dẫn tại ô A1 của file tổng hợp), chương trình này chạy và lấy dữ liệu bình thường (ngoại trừ lỗi đang đề cập)
2. Sai !
Tất cả các ô cần lấy dữ liệu, ở các file dữ liệu, sẽ được gom về 1 file tổng hợp, sắp xếp lại theo hàng bắt đầu từ hàng 2 (trên bài mình để là hàng 1, đã edit lại)
A2,B2,C2,D2,E2
A3,B3,C3,D3,E3
...
 
881516 đã viết:
Nội dung của hàm này như sau ạ:
Lấy dữ liệu từ các ô (E4, I6, P6, G8, H23, D31, K36, P36, K37, P37, U35, J41, J45, P45, J45, AB70, H68, H69)
trong các file 1,2,3 .... (công thức chỉ dài ở đoạn này)
Sắp xếp vào các ô ở 1 file mới

A2, B2, C2, D2, E2 ...
A3, B3, C3, D3, E3 ...
....

Em có nhờ 1 người làm hộ công thức này, nhưng ko hiểu sao các ô K37, P37, và H68 H69 ko lấy đc dữ liệu để nhập vào. Nếu xóa P36, K36 đi thì K37, P37 lại nhập đc
Vậy nhờ anh chị kiểm tra giúp em ạ
Nhấp chuột vào đây để mở rộng...

Bạn cho mình xin cái screenshot vị trí ô K36 và K37 hoặc cái file dữ liệu của bạn.
 
phuyen89 đã viết:
File, phải có file mới test code của bạn được.
Nhấp chuột vào đây để mở rộng...
Đúng vậy. Phải có file mới test code của bạn được. Không cần gửi 3 file 1, 2, 3 . Chỉ cần gửi file có code trên.
Cũng chú ý là lấy nội dung của các file 1, 2, 3 và ghi vô file chứa code
 
Gửi các bạn
File lấy dữ liệu là file ToKhai đặt trong thư mục X, đường dẫn là Y
File tổng hợp là file IMEX, dữ liệu tổng hợp vào sheet 1, link Y đặt vào ô A1 nhé
Nhờ mọi người check giúp nha
 

File đính kèm

  • ToKhaiHQ7N_101478316000.xls
    88.5 KB · Đọc: 7
  • ToKhaiHQ7N_101478351440.xls
    88.5 KB · Đọc: 7
  • IMEX - Hung - Copy.xlsm
    41.7 KB · Đọc: 7
Mình Test có vấn đề gì đâu nhỉ?
data-import.jpg
 

File đính kèm

  • data-k36.jpg
    data-k36.jpg
    178 KB · Đọc: 4
Bạn thử lại với đoạn code sau nhé!

Mã: 
Sub test()
Dim FolderPath As String, FileName As String, strFileTarget As String
Dim wb As Excel.Workbook
Dim i As Integer, lastRow As Integer
Dim DataArr(17) As Variant

FolderPath = Range("A1").Value & "\"        'Duong dan thu muc do tim
FileName = Dir(FolderPath & "*.xls*")       'Tim trong thu muc tat ca cac file *.xls*
strFileTarget = "IMEX - Hung - Copy.xlsm"          'Ten file macro chay

Set FSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
If FSO.FolderExists(FolderPath) Then
   
    Do While FileName <> ""
        If FileName <> strFileTarget Then
       
            On Error Resume Next
            Set wb = Workbooks.Open(FolderPath & FileName)
            If Err.Number <> 0 Then: MsgBox ("Unable to open file " & FileName)
            On Error GoTo 0
            lastRow = Workbooks(strFileTarget).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
           
    '        Workbooks(FileName).Worksheets(1).Range(Cells(5, 2), Cells(10, 2)).Copy
    '        Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

            DataArr(0) = Workbooks(FileName).Worksheets(1).Range("E4").Value: DataArr(1) = Workbooks(FileName).Worksheets(1).Range("I6").Value
            DataArr(2) = Workbooks(FileName).Worksheets(1).Range("P6").Value: DataArr(3) = Workbooks(FileName).Worksheets(1).Range("G8").Value
            DataArr(4) = Workbooks(FileName).Worksheets(1).Range("H23").Value: DataArr(5) = Workbooks(FileName).Worksheets(1).Range("D31").Value
            DataArr(6) = Workbooks(FileName).Worksheets(1).Range("K36").Value: DataArr(7) = Workbooks(FileName).Worksheets(1).Range("P36").Value
            DataArr(8) = Workbooks(FileName).Worksheets(1).Range("K37").Value: DataArr(9) = Workbooks(FileName).Worksheets(1).Range("P37").Value
            DataArr(10) = Workbooks(FileName).Worksheets(1).Range("U35").Value: DataArr(11) = Workbooks(FileName).Worksheets(1).Range("J41").Value
            DataArr(12) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(13) = Workbooks(FileName).Worksheets(1).Range("P45").Value
            DataArr(14) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(15) = Workbooks(FileName).Worksheets(1).Range("AB70").Value
            DataArr(16) = Workbooks(FileName).Worksheets(1).Range("H68").Value: DataArr(17) = Workbooks(FileName).Worksheets(1).Range("H69").Value
           
            For i = 0 To UBound(DataArr)
                    Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, i + 1).Value = Trim(DataArr(i))
            Next

            Application.Wait (Now + TimeValue("0:00:01"))
            Workbooks(FileName).Close SaveChanges:=False

           
        End If
       
        FileName = Dir
    Loop

Else
    MsgBox folder & "Specified Folder Not Found", vbInformation, "Not Found!"
End If
MsgBox ("Well Done!")
Application.ScreenUpdating = True
End Sub
 
excel9 đã viết:
Bạn thử lại với đoạn code sau nhé!

Mã: 
Sub test()
Dim FolderPath As String, FileName As String, strFileTarget As String
Dim wb As Excel.Workbook
Dim i As Integer, lastRow As Integer
Dim DataArr(17) As Variant

FolderPath = Range("A1").Value & "\"        'Duong dan thu muc do tim
FileName = Dir(FolderPath & "*.xls*")       'Tim trong thu muc tat ca cac file *.xls*
strFileTarget = "IMEX - Hung - Copy.xlsm"          'Ten file macro chay

Set FSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
If FSO.FolderExists(FolderPath) Then
  
    Do While FileName <> ""
        If FileName <> strFileTarget Then
      
            On Error Resume Next
            Set wb = Workbooks.Open(FolderPath & FileName)
            If Err.Number <> 0 Then: MsgBox ("Unable to open file " & FileName)
            On Error GoTo 0
            lastRow = Workbooks(strFileTarget).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
          
    '        Workbooks(FileName).Worksheets(1).Range(Cells(5, 2), Cells(10, 2)).Copy
    '        Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

            DataArr(0) = Workbooks(FileName).Worksheets(1).Range("E4").Value: DataArr(1) = Workbooks(FileName).Worksheets(1).Range("I6").Value
            DataArr(2) = Workbooks(FileName).Worksheets(1).Range("P6").Value: DataArr(3) = Workbooks(FileName).Worksheets(1).Range("G8").Value
            DataArr(4) = Workbooks(FileName).Worksheets(1).Range("H23").Value: DataArr(5) = Workbooks(FileName).Worksheets(1).Range("D31").Value
            DataArr(6) = Workbooks(FileName).Worksheets(1).Range("K36").Value: DataArr(7) = Workbooks(FileName).Worksheets(1).Range("P36").Value
            DataArr(8) = Workbooks(FileName).Worksheets(1).Range("K37").Value: DataArr(9) = Workbooks(FileName).Worksheets(1).Range("P37").Value
            DataArr(10) = Workbooks(FileName).Worksheets(1).Range("U35").Value: DataArr(11) = Workbooks(FileName).Worksheets(1).Range("J41").Value
            DataArr(12) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(13) = Workbooks(FileName).Worksheets(1).Range("P45").Value
            DataArr(14) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(15) = Workbooks(FileName).Worksheets(1).Range("AB70").Value
            DataArr(16) = Workbooks(FileName).Worksheets(1).Range("H68").Value: DataArr(17) = Workbooks(FileName).Worksheets(1).Range("H69").Value
          
            For i = 0 To UBound(DataArr)
                    Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, i + 1).Value = Trim(DataArr(i))
            Next

            Application.Wait (Now + TimeValue("0:00:01"))
            Workbooks(FileName).Close SaveChanges:=False

          
        End If
      
        FileName = Dir
    Loop

Else
    MsgBox folder & "Specified Folder Not Found", vbInformation, "Not Found!"
End If
MsgBox ("Well Done!")
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...


Hi bạn, xin lỗi mình đào mộ chút nhé.
Hiện mình gặp rắc rối với file này về vấn đề định dạng

Ví dụ ô AB70 là tỉ giá, trên file gốc là 22.690 nhưng sau khi chạy sang file tổng hợp nó lại hiện là 22.69

ô G8 là ngày tháng, nếu dữ liệu ở ô gốc là 10/04/2018 thì ko hiểu sao sau khi chạy macro nó lại hiện thành 04-10-2018 ở file tổng hợp và máy nó convert thành 04 Otc 18
(tổng quát là nếu ngày ở file gốc <12 thì nó bị đảo ngày và tháng cho nhau)

Mình có tìm hiểu là do lỗi định dạng vùng ở máy mình, mình khắc phục đc nhưng lại lỗi phần khác. Vậy để đơn giản, bạn có thể giúp mình chỉnh lại sao cho ô dữ liệu nguồn như nào thì sang file tổng hợp vẫn y nguyên như vậy đc ko, phần xử lý số liệu mình sẽ tự làm

Cảm ơn bạn
 
881516 đã viết:
Hi bạn, xin lỗi mình đào mộ chút nhé.
Hiện mình gặp rắc rối với file này về vấn đề định dạng

Ví dụ ô AB70 là tỉ giá, trên file gốc là 22.690 nhưng sau khi chạy sang file tổng hợp nó lại hiện là 22.69

ô G8 là ngày tháng, nếu dữ liệu ở ô gốc là 10/04/2018 thì ko hiểu sao sau khi chạy macro nó lại hiện thành 04-10-2018 ở file tổng hợp và máy nó convert thành 04 Otc 18
(tổng quát là nếu ngày ở file gốc <12 thì nó bị đảo ngày và tháng cho nhau)

Mình có tìm hiểu là do lỗi định dạng vùng ở máy mình, mình khắc phục đc nhưng lại lỗi phần khác. Vậy để đơn giản, bạn có thể giúp mình chỉnh lại sao cho ô dữ liệu nguồn như nào thì sang file tổng hợp vẫn y nguyên như vậy đc ko, phần xử lý số liệu mình sẽ tự làm

Cảm ơn bạn
Nhấp chuột vào đây để mở rộng...
Do dữ liệu nguồn của bạn định dạng text hết nên nếu muốn sang file tổng hợp giống y nguyên thì bạn có thể sửa như vầy:


Mã: 
Sub test()
Dim FolderPath As String, FileName As String, strFileTarget As String
Dim wb As Excel.Workbook
Dim i As Integer, lastRow As Integer
Dim DataArr(17) As String

FolderPath = Range("A1").Value & "\"        'Duong dan thu muc do tim
FileName = Dir(FolderPath & "*.xls*")       'Tim trong thu muc tat ca cac file *.xls*
strFileTarget = "IMEX - Hung - Copy.xlsm"          'Ten file macro chay

Set FSO = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
If FSO.FolderExists(FolderPath) Then
  
    Do While FileName <> ""
        If FileName <> strFileTarget Then
      
            On Error Resume Next
            Set wb = Workbooks.Open(FolderPath & FileName)
            If Err.Number <> 0 Then: MsgBox ("Unable to open file " & FileName)
            On Error GoTo 0
            lastRow = Workbooks(strFileTarget).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
          
    '        Workbooks(FileName).Worksheets(1).Range(Cells(5, 2), Cells(10, 2)).Copy
    '        Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

            DataArr(0) = Workbooks(FileName).Worksheets(1).Range("E4").Value: DataArr(1) = Workbooks(FileName).Worksheets(1).Range("I6").Value
            DataArr(2) = Workbooks(FileName).Worksheets(1).Range("P6").Value: DataArr(3) = Workbooks(FileName).Worksheets(1).Range("G8").Value
            DataArr(4) = Workbooks(FileName).Worksheets(1).Range("H23").Value: DataArr(5) = Workbooks(FileName).Worksheets(1).Range("D31").Value
            DataArr(6) = Workbooks(FileName).Worksheets(1).Range("K36").Value: DataArr(7) = Workbooks(FileName).Worksheets(1).Range("P36").Value
            DataArr(8) = Workbooks(FileName).Worksheets(1).Range("K37").Value: DataArr(9) = Workbooks(FileName).Worksheets(1).Range("P37").Value
            DataArr(10) = Workbooks(FileName).Worksheets(1).Range("U35").Value: DataArr(11) = Workbooks(FileName).Worksheets(1).Range("J41").Value
            DataArr(12) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(13) = Workbooks(FileName).Worksheets(1).Range("P45").Value
            DataArr(14) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(15) = Workbooks(FileName).Worksheets(1).Range("AB70").Value
            DataArr(16) = Workbooks(FileName).Worksheets(1).Range("H68").Value: DataArr(17) = Workbooks(FileName).Worksheets(1).Range("H69").Value
          
            For i = 0 To UBound(DataArr)
                    Workbooks(strFileTarget).Worksheets(1).Cells(lastRow + 1, i + 1).Value = "'" & Trim(DataArr(i))
            Next

            Application.Wait (Now + TimeValue("0:00:01"))
            Workbooks(FileName).Close SaveChanges:=False

          
        End If
      
        FileName = Dir
    Loop

Else
    MsgBox folder & "Specified Folder Not Found", vbInformation, "Not Found!"
End If
MsgBox ("Well Done!")
Application.ScreenUpdating = True
End Sub

như vậy thì dữ liệu File tổng hợp sẽ giống với nguồn, đều là text hết
 
thanh.bq đã viết:
Do dữ liệu nguồn của bạn định dạng text hết nên nếu muốn sang file tổng hợp giống y nguyên thì bạn có thể sửa như vầy:
như vậy thì dữ liệu File tổng hợp sẽ giống với nguồn, đều là text hết
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn, rất nhiều :((

Nhân tiện mình muốn hỏi thêm
Mình có chọn thêm 1 ô để lấy dữ liệu và edit phần macro như dưới (cụ thể là số 15, cột X171 mình cần lấy thêm)
Khi chạy công thức thì báo lỗi ở ô 18 bôi vàng (mình để chữ màu hồng)

DataArr(0) = Workbooks(FileName).Worksheets(1).Range("E4").Value: DataArr(1) = Workbooks(FileName).Worksheets(1).Range("I6").Value
DataArr(2) = Workbooks(FileName).Worksheets(1).Range("P6").Value: DataArr(3) = Workbooks(FileName).Worksheets(1).Range("G8").Value
DataArr(4) = Workbooks(FileName).Worksheets(1).Range("H23").Value: DataArr(5) = Workbooks(FileName).Worksheets(1).Range("D31").Value
DataArr(6) = Workbooks(FileName).Worksheets(1).Range("K36").Value: DataArr(7) = Workbooks(FileName).Worksheets(1).Range("P36").Value
DataArr(8) = Workbooks(FileName).Worksheets(1).Range("K37").Value: DataArr(9) = Workbooks(FileName).Worksheets(1).Range("P37").Value
DataArr(10) = Workbooks(FileName).Worksheets(1).Range("U35").Value: DataArr(11) = Workbooks(FileName).Worksheets(1).Range("J41").Value
DataArr(12) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(13) = Workbooks(FileName).Worksheets(1).Range("P45").Value
DataArr(14) = Workbooks(FileName).Worksheets(1).Range("D64").Value: DataArr(15) = Workbooks(FileName).Worksheets(1).Range("X171").Value
DataArr(16) = Workbooks(FileName).Worksheets(1).Range("AB70").Value: DataArr(17) = Workbooks(FileName).Worksheets(1).Range("H68").Value
DataArr(18) = Workbooks(FileName).Worksheets(1).Range("H69").Value
 
881516 đã viết:
Cảm ơn bạn, rất nhiều :((

Nhân tiện mình muốn hỏi thêm
Mình có chọn thêm 1 ô để lấy dữ liệu và edit phần macro như dưới (cụ thể là số 15, cột X171 mình cần lấy thêm)
Khi chạy công thức thì báo lỗi ở ô 18 bôi vàng (mình để chữ màu hồng)

DataArr(0) = Workbooks(FileName).Worksheets(1).Range("E4").Value: DataArr(1) = Workbooks(FileName).Worksheets(1).Range("I6").Value
DataArr(2) = Workbooks(FileName).Worksheets(1).Range("P6").Value: DataArr(3) = Workbooks(FileName).Worksheets(1).Range("G8").Value
DataArr(4) = Workbooks(FileName).Worksheets(1).Range("H23").Value: DataArr(5) = Workbooks(FileName).Worksheets(1).Range("D31").Value
DataArr(6) = Workbooks(FileName).Worksheets(1).Range("K36").Value: DataArr(7) = Workbooks(FileName).Worksheets(1).Range("P36").Value
DataArr(8) = Workbooks(FileName).Worksheets(1).Range("K37").Value: DataArr(9) = Workbooks(FileName).Worksheets(1).Range("P37").Value
DataArr(10) = Workbooks(FileName).Worksheets(1).Range("U35").Value: DataArr(11) = Workbooks(FileName).Worksheets(1).Range("J41").Value
DataArr(12) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(13) = Workbooks(FileName).Worksheets(1).Range("P45").Value
DataArr(14) = Workbooks(FileName).Worksheets(1).Range("D64").Value: DataArr(15) = Workbooks(FileName).Worksheets(1).Range("X171").Value
DataArr(16) = Workbooks(FileName).Worksheets(1).Range("AB70").Value: DataArr(17) = Workbooks(FileName).Worksheets(1).Range("H68").Value
DataArr(18) = Workbooks(FileName).Worksheets(1).Range("H69").Value
Nhấp chuột vào đây để mở rộng...
Do lệnh:
Dim DataArr(17) As String
 
881516 đã viết:
Cảm ơn bạn, rất nhiều :((

Nhân tiện mình muốn hỏi thêm
Mình có chọn thêm 1 ô để lấy dữ liệu và edit phần macro như dưới (cụ thể là số 15, cột X171 mình cần lấy thêm)
Khi chạy công thức thì báo lỗi ở ô 18 bôi vàng (mình để chữ màu hồng)

DataArr(0) = Workbooks(FileName).Worksheets(1).Range("E4").Value: DataArr(1) = Workbooks(FileName).Worksheets(1).Range("I6").Value
DataArr(2) = Workbooks(FileName).Worksheets(1).Range("P6").Value: DataArr(3) = Workbooks(FileName).Worksheets(1).Range("G8").Value
DataArr(4) = Workbooks(FileName).Worksheets(1).Range("H23").Value: DataArr(5) = Workbooks(FileName).Worksheets(1).Range("D31").Value
DataArr(6) = Workbooks(FileName).Worksheets(1).Range("K36").Value: DataArr(7) = Workbooks(FileName).Worksheets(1).Range("P36").Value
DataArr(8) = Workbooks(FileName).Worksheets(1).Range("K37").Value: DataArr(9) = Workbooks(FileName).Worksheets(1).Range("P37").Value
DataArr(10) = Workbooks(FileName).Worksheets(1).Range("U35").Value: DataArr(11) = Workbooks(FileName).Worksheets(1).Range("J41").Value
DataArr(12) = Workbooks(FileName).Worksheets(1).Range("J45").Value: DataArr(13) = Workbooks(FileName).Worksheets(1).Range("P45").Value
DataArr(14) = Workbooks(FileName).Worksheets(1).Range("D64").Value: DataArr(15) = Workbooks(FileName).Worksheets(1).Range("X171").Value
DataArr(16) = Workbooks(FileName).Worksheets(1).Range("AB70").Value: DataArr(17) = Workbooks(FileName).Worksheets(1).Range("H68").Value
DataArr(18) = Workbooks(FileName).Worksheets(1).Range("H69").Value
Nhấp chuột vào đây để mở rộng...
bạn sửa chỗ này Dim DataArr(17) As String thành Dim DataArr(18) As String vì mảng khai báo chỉ đến 17 mà bạn them vào cái DataArr(18) nên lỗi
 
thanh.bq đã viết:
bạn sửa chỗ này Dim DataArr(17) As String thành Dim DataArr(18) As String vì mảng khai báo chỉ đến 17 mà bạn them vào cái DataArr(18) nên lỗi
Nhấp chuột vào đây để mở rộng...
Hi bạn
sorry mình tìm lại topic một chút.
Bạn có thể giúp mình một yêu cầu nhỏ như này đc ko.
Hiện tại macro này đang lấy dữ liệu từ tất cả các file chứa ở thư mục có đường dẫn tại ô A1.
Mình muốn chỉnh lại thành lấy dữ liệu từ các file đc chọn, sau khi lấy dữ liệu sẽ ko bị mất dữ liệu cũ.
mong bạn giúp đỡ nhé
Thanks
 
Status
Không mở trả lời sau này.
Web KT

Bài viết mới nhất

quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
Trả lời
10
Đọc
1K
quangminhici
quangminhici
V
Chuyển chữ sang bảng mã unicode
Trả lời
5
Đọc
153
vanlethanh
V
befaint
[ Python và ứng dụng ] Siêu siêu phẩm đồng bộ giữa Excel và Google Sheets theo thời gian thực
    • Thích
    • Yêu thích
Trả lời
7
Đọc
214
Kiều Mạnh
Kiều Mạnh
L
[Xin giúp đỡ] Công thức tính thời gian làm được tính tiền mà không tính thời gian nghỉ
2
Trả lời
21
Đọc
885
Lá chanh
L
TMai1510
the formula you typed contains an error
Trả lời
4
Đọc
32
hoangtuaotrang_hp_vn
H
Ted pham
Cần hướng dẫn filter theo total
Trả lời
1
Đọc
9
hoangtuaotrang_hp_vn
H
Kiều Mạnh
Lấy dữ liệu cổ phiếu từ Website Cafef.vn về Excel
    • Thích
2 3 4
Trả lời
72
Đọc
2K
Kiều Mạnh
Kiều Mạnh
T
Cần giúp đỡ viết measure bằng dax cho power pivot
    • Thích
Trả lời
6
Đọc
139
tranhungdao12a3
T
dungluf123
Lỗi khi sử dụng công thức để link từ file này sang file khác của Excel trên hệ thống mạng chung của công ty
Trả lời
4
Đọc
328
Hoan Trung
H
A
  • Question
Code di dời cùng hàng nhưng cố định cột
Trả lời
10
Đọc
168
AnhThu-1976
A
hoamattroicoi
Trích xuất file *.xml sang Excel cho hóa đơn điện tử áp dụng nghị định 123/2020
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
109
Đọc
27K
Hoàng Tuấn 868
H
N
tự động thêm dữ liệu giữa sheet con vào sheet tổng không dùng VBA
    • Cười
Trả lời
5
Đọc
114
DeTong
D
nvhieutk
  • Question
WorksheetFunction.SumIfs() trong VBA tính sai
2
Trả lời
21
Đọc
366
VetMini
V
L
Nhờ các bạn sửa hộ em công thức if ạ
Trả lời
14
Đọc
224
ptm0412
ptm0412
thlpro
Tổng Hợp Dữ Liệu Từ Nhiều Sheet
Trả lời
8
Đọc
192
DeTong
D
PhanTuHuong
Microsoft Excel sắp hỗ trợ ngôn ngữ Python (chính thức)
    • Thích
Trả lời
2
Đọc
116
PhanTuHuong
PhanTuHuong
A
  • Question
Share file copy dữ liệu từ tờ khai hải quan.
    • Thích
Trả lời
9
Đọc
495
HUONGHCKT
H
HongĐp
Mọi người giúp e chia nhóm với ạ
Trả lời
4
Đọc
97
CHAOQUAY
C
S
TÍNH GIỜ ĐI TRỄ THEO CA LÀM VIỆC
Trả lời
12
Đọc
293
Phan Thế Hiệp
Phan Thế Hiệp
L
xin chào mọi người
Trả lời
0
Đọc
34
linhdan2306
L
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom