Nhờ trợ giúp về trích xuất dữ liệu

Liên hệ QC

597335

Thành viên hoạt động
Tham gia
19/2/12
Bài viết
126
Được thích
29
Tôi đang tổng hợp dữ liệu các công việc ra Sheet mới, làm mãi không được, mong các bạn giúp hộ 1 tay

PHP:
Sub TH()
    Dim sArr(), Arr(), i As Long, j As Long
    sArr = Range([A5], [H65000].End(xlUp).Row).Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1) - 1
        If sArr(i, 1) <> "" Then
            j = j + 1
            Arr(j, 1) = sArr(i, 1)
            Arr(j, 2) = sArr(i, 2)
            Arr(j, 3) = sArr(i, 3)
            Arr(j, 4) = sArr(i, 4)
        ElseIf sArr(i, 1) = "" And sArr(i + 1, 1) <> "" Then
            Arr(j, 5) = sArr(i, 8)
        End If
    Next
    Sheets("Sheet1").[A5].Resize(j, 5).Value = Arr
End Sub
 

File đính kèm

  • Don gia.xlsx
    87.6 KB · Đọc: 30
Bạn sai dòng lệnh này :
sArr = Range([A5], [H65000].End(xlUp).Row).Value

Sửa thành :

sArr = Range([A5], [H65000].End(xlUp)).Value

Còn vì sao thì trên diễn đàn này có quá nhiều người hỏi rồi, bạn tự search nhẹ
Thanks!
 
Upvote 0
Tôi đã sửa được nhờ chỗ bác chỉ sai, nhưng xin hỏi tiếp, bên Chủ đầu tư bắt chúng tôi phải gửi File Excel sang cho họ kiểm tra.

Dĩ nhiên, họ không quan tâm đến VBA, điều họ muốn là công thức các Sheet phải liên kết với nhau, tức kết quả không phải Value nữa mà là thể hiện bằng Formulla,

Cụ thể, ô E5 của Sheet kết quả phải có dấu bằng (='Don gia chi tiet'!H17)... thì tôi phải làm thế nào cho hiện ra công thức?
 
Upvote 0
Tôi đã sửa được nhờ chỗ bác chỉ sai, nhưng xin hỏi tiếp, bên Chủ đầu tư bắt chúng tôi phải gửi File Excel sang cho họ kiểm tra.

Dĩ nhiên, họ không quan tâm đến VBA, điều họ muốn là công thức các Sheet phải liên kết với nhau, tức kết quả không phải Value nữa mà là thể hiện bằng Formulla,

Cụ thể, ô E5 của Sheet kết quả phải có dấu bằng (='Don gia chi tiet'!H17)... thì tôi phải làm thế nào cho hiện ra công thức?
Tôi lại tưởng bạn muốn học VBA,hic, nếu thế thì bạn dùng luôn công thức lọc đi nhưng hơn 1000 dòng đó.huhuhu!
- Tạo 1 name đánh dấu những dòng không trống của cột A
- Dùng Index kết hợp với Small để trích
Dạng bài này có rất nhiều trên GPE, bạn có thể search với từ khóa :"Lọc dữ liệu có điều kiện"
Thanks!
 
Lần chỉnh sửa cuối:
Upvote 0
Không, đi theo con đường Name lọc Excel thông thường dữ liệu lớn nó đơ máy lắm, trước tôi hào hứng với nó, nhưng nay chán rồi.

tôi vẫn muốn học VBA chỉ có điều làm thế nào cho nó hiện ra Fomulla để liên kết, dễ kiểm tra thôi.

Tôi định nghĩ ra theo kiểu:
Arr(j, 5).Formula = "=sArr(i, 8)" nhưng mà không đúng ?
 
Lần chỉnh sửa cuối:
Upvote 0
Cho tôi hỏi thêm chút, tôi muốn chỉ đích danh Sheet đầu vào bằng cách cho With..End With vào sao lại không được, cụ thể tôi sửa như sau:

PHP:
Sub TH()
    Dim sArr(), Arr(), i As Long, j As Long
    With Sheets("Don gia chi tiet")
        sArr = Range([A5], [H65000].End(xlUp)).Value
    End With
    ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1) - 1
        If sArr(i, 1) <> "" Then
            j = j + 1
            Arr(j, 1) = sArr(i, 1)
            Arr(j, 2) = sArr(i, 2)
            Arr(j, 3) = sArr(i, 3)
            Arr(j, 4) = sArr(i, 4)
        ElseIf sArr(i, 1) = "" And sArr(i + 1, 1) <> "" Then
            Arr(j, 5) = sArr(i, 8)
        End If
    Next
    Sheets("Sheet1").[A5].Resize(j, 5).Value = Arr
End Sub
 
Upvote 0
Thêm With...End With thì phải thế này :
sArr = Range( .[A5], .[H65000].End(xlUp)).Value
 
Upvote 0
Code của bạn vẫn thiếu trường hợp dòng công việc cuối không có đơn giá, đầy đủ phải thế này
PHP:
Sub TH()
    Dim sArr(), Arr(), i As Long, j As Long
    With Sheets("Don gia chi tiet")
        sArr = Range(.[A5], .[H65000].End(xlUp)).Value
    End With
    ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1) - 1
        If sArr(i, 1) <> "" Then
            j = j + 1
            Arr(j, 1) = sArr(i, 1)
            Arr(j, 2) = sArr(i, 2)
            Arr(j, 3) = sArr(i, 3)
            Arr(j, 4) = sArr(i, 4)
        ElseIf sArr(i, 1) = "" And sArr(i + 1, 1) <> "" Then
            Arr(j, 5) = sArr(i, 8)
        End If
    Next
    If i = UBound(sArr, 1) Then
        Arr(j, 5) = sArr(i, 8)
    End If
    Sheets("Sheet1").[A5].Resize(j, 5).Value = Arr
End Sub
 
Upvote 0
Không, đi theo con đường Name lọc Excel thông thường dữ liệu lớn nó đơ máy lắm, trước tôi hào hứng với nó, nhưng nay chán rồi.

tôi vẫn muốn học VBA chỉ có điều làm thế nào cho nó hiện ra Fomulla để liên kết, dễ kiểm tra thôi.

Tôi định nghĩ ra theo kiểu:
Arr(j, 5).Formula = "=sArr(i, 8)" nhưng mà không đúng ?
Riêng vụ này thì HMT chưa nghĩ ra cách gì giúp được bạn, trình độ có hạn đành nhờ các cao thủ ra tay giup.Tuy nhiên nếu gán công thức như của bạn là sai hoàn toàn cú pháp câu lệnh rui.Hic!
 
Upvote 0
Bạn thử chạy code này xem sao:
Mã:
Sub Loc()
    Dim sArr(), Arr(), i As Long, j As Long, Vung, Ws
    Set Ws = Sheets("Don gia chi tiet")
    Set Vung = Ws.Range(Ws.[A5], Ws.[H65000].End(xlUp))
    sArr = Vung.Value
    ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1) - 1
        If sArr(i, 1) <> "" Then
            j = j + 1
            Arr(j, 1) = sArr(i, 1)
            Arr(j, 2) = sArr(i, 2)
            Arr(j, 3) = sArr(i, 3)
            Arr(j, 4) = sArr(i, 4)
        ElseIf sArr(i, 1) = "" And sArr(i + 1, 1) <> "" Then
            Arr(j, 5) = "= 'Don gia chi tiet'!" & Vung(i, 8).Address
        End If
            If i = UBound(sArr) - 1 Then
                Arr(j, 5) = "= 'Don gia chi tiet'!" & Vung(i + 1, 8).Address
            End If
    Next
    Sheets("Sheet1").[A5:E10000].ClearContents
    Sheets("Sheet1").[A5].Resize(j, 5).Value = Arr
End Sub
 
Upvote 0
Nghĩa là các bài toán muốn hiện công thức thì phải chuyển về dùng Set và Address phải không bác.
 
Upvote 0
Web KT
Back
Top Bottom