Xin giúp đỡ code lấy dữ liệu (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
P

phuoclocvl

Thành viên thường trực
Tham gia
28/3/12
Bài viết
220
Được thích
32
Anh chị giúp em lấy dât từ sheet Data qua bên sheet Root. giống như file.

Em có sheet Root là danh sách item đã được break ra nhiều dòng. như item bên là U7370086 bên sheet Root là 52 dòng .
Bên sheet Data có
21 của ngày 10/07/2015
21 của ngày 10/14/2015
28 của Waiting booking cfrm

Em muốn nó sẽ lấy số lượng từ sheet data
21 dòng đầu là của 10/07/2015 và 21 dòng tiếp theo là của 10/14/2015 và còn lại 10 dòng là của Waiting booking cfrm . nói túm lại là gisup em làm sao lấy số lượng từ sheet Data qua Sheet Root làm sao khi hết của ngày này thì lấy tiếp qua ngày ngày khác.
Cảm ơn A.C nhiều! ^^

A.C xem giúp em file đính kèm để thấy rõ hơn
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
phuoclocvl đã viết:
Anh chị giúp em lấy dât từ sheet Data qua bên sheet Root. giống như file.

Em có sheet Root là danh sách item đã được break ra nhiều dòng. như item bên là U7370086 bên sheet Root là 52 dòng .
Bên sheet Data có
21 của ngày 10/07/2015
21 của ngày 10/14/2015
28 của Waiting booking cfrm

Em muốn nó sẽ lấy số lượng từ sheet data
21 dòng đầu là của 10/07/2015 và 21 dòng tiếp theo là của 10/14/2015 và còn lại 10 dòng là của Waiting booking cfrm . nói túm lại là gisup em làm sao lấy số lượng từ sheet Data qua Sheet Root làm sao khi hết của ngày này thì lấy tiếp qua ngày ngày khác.
Cảm ơn A.C nhiều! ^^

A.C xem giúp em file đính kèm để thấy rõ hơn
Nhấp chuột vào đây để mở rộng...

Nếu cả sheet Root và Data chỉ có 1 Item Number thì chạy code này, nếu có nhiều hơn 1 Item thì phải sửa code lại.
PHP: 
Public Sub GPE_()
Dim tArr(), dArr(), I As Long, K As Long, N As Long, Erow As Long, Num As Long
With Sheets("Data")
    tArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
With Sheets("Root")
    Erow = .[B3].End(xlDown).Row - 2
    ReDim dArr(1 To Erow, 1 To 2)
    For N = 1 To UBound(tArr, 1)
        Num = tArr(N, 2)
        For I = 1 To Num
            K = K + 1
            If K <= Erow Then
                dArr(K, 1) = 1
                dArr(K, 2) = tArr(N, 3)
            Else
                Exit For
                Exit For
            End If
        Next I
    Next N
    .[C3:D3].Resize(Erow) = dArr
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Nếu cả sheet Root và Data chỉ có 1 Item Number thì chạy code này, nếu có nhiều hơn 1 Item thì phải sửa code lại.
PHP: 
Public Sub GPE_()
Dim tArr(), dArr(), I As Long, K As Long, N As Long, Erow As Long, Num As Long
With Sheets("Data")
    tArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
With Sheets("Root")
    Erow = .[B3].End(xlDown).Row - 2
    ReDim dArr(1 To Erow, 1 To 2)
    For N = 1 To UBound(tArr, 1)
        Num = tArr(N, 2)
        For I = 1 To Num
            K = K + 1
            If K <= Erow Then
                dArr(K, 1) = 1
                dArr(K, 2) = tArr(N, 3)
            Else
                Exit For
                Exit For
            End If
        Next I
    Next N
    .[C3:D3].Resize(Erow) = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Nhiều item lắm tại em lấy đại diện 1 item thôi
cho em code nhiều item đi
 
Upvote 0
phuoclocvl đã viết:
Nhiều item lắm tại em lấy đại diện 1 item thôi
cho em code nhiều item đi
Nhấp chuột vào đây để mở rộng...

Sao cho được? Bạn phải tự đưa file có nhiều Item trong sheet Root và bên Data để mọi người xem kiểu dữ liệu của bạn mặt mũi nó thế nào chứ ai mà rảnh rỗi "giả sử" giúp bạn được.
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Sao cho được? Bạn phải tự đưa file có nhiều Item trong sheet Root và bên Data để mọi người xem kiểu dữ liệu của bạn mặt mũi nó thế nào chứ ai mà rảnh rỗi "giả sử" giúp bạn được được.
Nhấp chuột vào đây để mở rộng...
Em up lên file mới rồi , xem giúp em vơi.
Cảm ơn!
 

File đính kèm

Upvote 0
phuoclocvl đã viết:
Em up lên file mới rồi , xem giúp em vơi.
Cảm ơn!
Nhấp chuột vào đây để mở rộng...

Xem rồi và "tá hoả" rồi. Dữ liệu thật đúng vậy không?
Nếu dữ liệu thật của bạn như vậy là code kia "phá sản".
Ví dụ Item 9200325W3 nằm ở các dòng 15, 18, 23, 43, 47, 51, 67 không liên tục như bài đầu.
Lúc đầu mà đưa dữ liệu giống thật thì chắc sẽ suy nghĩ cách khác. Bây giờ "bó tay", chờ "ngâm kiếu".
 
Upvote 0
Ba Tê đã viết:
Xem rồi và "tá hoả" rồi. Dữ liệu thật đúng vậy không?
Nếu dữ liệu thật của bạn như vậy là code kia "phá sản".
Ví dụ Item 9200325W3 nằm ở các dòng 15, 18, 23, 43, 47, 51, 67 không liên tục như bài đầu.
Lúc đầu mà đưa dữ liệu giống thật thì chắc sẽ suy nghĩ cách khác. Bây giờ "bó tay", chờ "ngâm kiếu".
Nhấp chuột vào đây để mở rộng...
Dạ cảm ơn Anh,
Anh suy nghĩ cách giúp em.
Em đội ơn bác **~**
 
Upvote 0
Các pro ơi giúp em với
Cảm ơn !
 
Lần chỉnh sửa cuối:
Upvote 0
phuoclocvl đã viết:
Dạ cảm ơn Anh,
Anh suy nghĩ cách giúp em.
Em đội ơn bác **~**
Nhấp chuột vào đây để mở rộng...

Không cần "đội ơn" đâu. Có cái nút Cảm ơn, biết sử dụng là đủ thành ý rồi.
Tôi đọc tới bài #7 nên làm thôi, giúp theo ý bài #8 thì thành "Rồ" gì đó tôi không khoái.
Dữ liệu "đảo điên" nên bạn tự kiểm tra nhé, tôi "bó tay", kiểm không nỗi.
PHP: 
Public Sub BoTay1()
Dim Dic As Object, sArr(), tArr(), I As Long, J As Long
Dim CoL As Long, Rws As Long, Num As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
'--------------------------------------------------------------'
With Sheets("Data")
    sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
    ReDim tArr(1 To UBound(sArr, 1), 1 To 1000)
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1): Num = sArr(I, 2)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            tArr(K, 1) = Tem
            tArr(K, 1000) = sArr(I, 2) + 1
            For J = 1 To Num
                tArr(K, J + 1) = sArr(I, 3)
            Next J
        Else
            Rws = Dic.Item(Tem)
            CoL = tArr(Rws, 1000)
            tArr(Rws, 1000) = tArr(Rws, 1000) + Num
            For J = 1 To Num
                tArr(Rws, CoL + J) = sArr(I, 3)
            Next J
        End If
    Next I
End With
'-------------------------------------------------------------------------'
With Sheets("Root")
    sArr = .Range(.[B3], .[B3].End(xlDown)).Value
    Rws = UBound(sArr, 1)
    ReDim dArr(1 To Rws, 1 To 2)
    For J = 1 To K
        Tem = tArr(J, 1): Num = 1
        For I = 1 To Rws
            If sArr(I, 1) = Tem Then
                Num = Num + 1
                dArr(I, 1) = 1
                dArr(I, 2) = tArr(J, Num)
            End If
        Next I
    Next J
    .[C3:D3].Resize(Rws) = dArr
End With
Set Dic = Nothing
End Sub

doveandrose đã viết:
Chủ đề có sự tham gia của bác Ba Tê mà bạn chêm mấy cái Tây bồi zô là tôi thấy khó cho bạn rồi đấy =)) //////////////////
Nhấp chuột vào đây để mở rộng...
Ngoài cái Thanks, còn bảo người khác là các "Rồ" nữa kìa.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
lâu lâu xí xớn với thầy Ba Tê chơi . hi hi
Mã: 
Public Sub hello()
Dim Dic As Object, arr, r As Long, tempKey, dArr, rsArr, indez As Long, lPos As Long, tempItem
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
    arr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
For r = 1 To UBound(arr) Step 1
    tempKey = arr(r, 1)
    If arr(r, 2) > 0 Then
        If Not Dic.exists(tempKey) Then
            Dic(tempKey) = r
        Else
            Dic(tempKey) = Dic(tempKey) & "," & r
        End If
    End If
Next
With Sheets("Root")
    dArr = .Range(.[B3], .[B3].End(xlDown)).Value
    ReDim rsArr(1 To UBound(dArr), 1 To 2)
    For r = 1 To UBound(dArr) Step 1
        tempKey = dArr(r, 1)
        If Dic.exists(tempKey) Then
            tempItem = Dic(tempKey)
            lPos = InStr(tempItem, ",")
            If lPos = 0 Then lPos = 1000
            indez = Left(tempItem, lPos - 1)
            rsArr(r, 1) = 1
            rsArr(r, 2) = arr(indez, 3)
            arr(indez, 2) = arr(indez, 2) - 1
            If arr(indez, 2) <= 0 Then tempItem = Mid(tempItem, lPos + 1)
            If Len(tempItem) > 0 Then Dic(tempKey) = tempItem Else Dic.Remove tempKey
        Else
            rsArr(r, 1) = "co dau ma tim cha noi"
            rsArr(r, 2) = "co dau ma tim cha noi"
        End If
    Next
    .[C3:D3].Resize(UBound(rsArr)) = rsArr
End With
End Sub
 
Upvote 0
doveandrose đã viết:
lâu lâu xí xớn với thầy Ba Tê chơi . hi hi
Mã: 
Public Sub hello()
Dim Dic As Object, arr, r As Long, tempKey, dArr, rsArr, indez As Long, lPos As Long, tempItem
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
    arr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
For r = 1 To UBound(arr) Step 1
    tempKey = arr(r, 1)
    If arr(r, 2) > 0 Then
        If Not Dic.exists(tempKey) Then
            Dic(tempKey) = r
        Else
            Dic(tempKey) = Dic(tempKey) & "," & r
        End If
    End If
Next
With Sheets("Root")
    dArr = .Range(.[B3], .[B3].End(xlDown)).Value
    ReDim rsArr(1 To UBound(dArr), 1 To 2)
    For r = 1 To UBound(dArr) Step 1
        tempKey = dArr(r, 1)
        If Dic.exists(tempKey) Then
            tempItem = Dic(tempKey)
            lPos = InStr(tempItem, ",")
            If lPos = 0 Then lPos = 1000
            indez = Left(tempItem, lPos - 1)
            rsArr(r, 1) = 1
            rsArr(r, 2) = arr(indez, 3)
            arr(indez, 2) = arr(indez, 2) - 1
            If arr(indez, 2) <= 0 Then tempItem = Mid(tempItem, lPos + 1)
            If Len(tempItem) > 0 Then Dic(tempKey) = tempItem Else Dic.Remove tempKey
        Else
            rsArr(r, 1) = "co dau ma tim cha noi"
            rsArr(r, 2) = "co dau ma tim cha noi"
        End If
    Next
    .[C3:D3].Resize(UBound(rsArr)) = rsArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Nick này hình như giống "ma", lúc thì "cái nào cũng chơi", lúc thì "cái gì cũng hỏi". Hổng "chơi" nick này cho chắc cú.
Thường thì "ăn cỗ đi trước, lội nước theo sau", Mình ham ăn đi trước, nhiều lúc "sụp hầm" là chuyện thường. Có đường người khác dọn sẵn, chặt thêm vài cây cỏ còn sót lại khỏi phải mỏi tay thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Nick này hình như giống "ma", lúc thì "cái nào cũng chơi", lúc thì "cái gì cũng hỏi". Hổng "chơi" nick này cho chắc cú.
Thường thì "ăn cỗ đi trước, lội nước theo sau", Mình ham ăn đi trước, nhiều lúc "sụp hầm" là chuyện thường. Có đường người khác dọn sẵn, chặt thêm vài cây cỏ còn sót lại khỏi phải mỏi tay thôi.
Nhấp chuột vào đây để mở rộng...

thầy nói chuyện có nhiều ý ẩn dụ quá đâm ra em chưa hiểu . có lẽ ta nên bàn lại để hiểu nhau chăng ?
1/lúc thì "cái nào cũng chơi", lúc thì "cái gì cũng hỏi"
cái gì biết thì thưa , không biết thì hỏi , em làm vậy có gì sai hoặc đã làm phiền thầy rồi chăng ?
2/"ăn cỗ đi trước, lội nước theo sau" => câu này chịu . không hiểu ý thầy .
3/Có đường người khác dọn sẵn, chặt thêm vài cây cỏ còn sót lại khỏi phải mỏi tay thôi => ý thầy là em viết bài trên dựa vào code có sẵn trước của thầy ? Dạ bài này em hổng có dựa vào ý tưởng của thầy đâu ạ . em viết code ở trên là có mục đích khác
khi chạy code của thầy , em nhận thấy có lỗ hổng :
Ở sheet Root khi số dòng dành cho 1 item (chẳng hạn U7370086) mà lớn hơn tổng cột B dành cho item đó bên sheet Data thì code của thầy vẫn cho cột C của item đó bên sheet Root = 1 ? điều này có vẻ không hợp lý . Nhưng thật ra cũng chả biết tình huống thực tế có xảy ra như vậy hay không nên em cứ làm sẵn vậy

các thầy là bậc cha chú của em . tất nhiên em còn phải học các thầy nhiều . Nhưng đối với em cái gì nó cũng phải rõ ràng
Em cũng không vô duyên tới mức học hỏi code của bài trên rồi lại ghi ngay xuống bài dưới .
khi cần học thì ngồi quan sát mà học . Khi cần lên tiếng em sẽ lên tiếng .
 
Upvote 0
Làm thế nào mà các Thầy và các anh giỏi quá vậy, phải làm thế nào mới học được cách viết code này.
Xin chỉ dạy em với.
Cảm ơn các Thầy và các anh nhiều ạ!
 
Upvote 0
Ba Tê đã viết:
Không cần "đội ơn" đâu. Có cái nút Cảm ơn, biết sử dụng là đủ thành ý rồi.
Tôi đọc tới bài #7 nên làm thôi, giúp theo ý bài #8 thì thành "Rồ" gì đó tôi không khoái.
Dữ liệu "đảo điên" nên bạn tự kiểm tra nhé, tôi "bó tay", kiểm không nỗi.
PHP: 
Public Sub BoTay1()
Dim Dic As Object, sArr(), tArr(), I As Long, J As Long
Dim CoL As Long, Rws As Long, Num As Long, K As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
'--------------------------------------------------------------'
With Sheets("Data")
    sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
    ReDim tArr(1 To UBound(sArr, 1), 1 To 1000)
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1): Num = sArr(I, 2)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            tArr(K, 1) = Tem
            tArr(K, 1000) = sArr(I, 2) + 1
            For J = 1 To Num
                tArr(K, J + 1) = sArr(I, 3)
            Next J
        Else
            Rws = Dic.Item(Tem)
            CoL = tArr(Rws, 1000)
            tArr(Rws, 1000) = tArr(Rws, 1000) + Num
            For J = 1 To Num
                tArr(Rws, CoL + J) = sArr(I, 3)
            Next J
        End If
    Next I
End With
'-------------------------------------------------------------------------'
With Sheets("Root")
    sArr = .Range(.[B3], .[B3].End(xlDown)).Value
    Rws = UBound(sArr, 1)
    ReDim dArr(1 To Rws, 1 To 2)
    For J = 1 To K
        Tem = tArr(J, 1): Num = 1
        For I = 1 To Rws
            If sArr(I, 1) = Tem Then
                Num = Num + 1
                dArr(I, 1) = 1
                dArr(I, 2) = tArr(J, Num)
            End If
        Next I
    Next J
    .[C3:D3].Resize(Rws) = dArr
End With
Set Dic = Nothing
End Sub


Ngoài cái Thanks, còn bảo người khác là các "Rồ" nữa kìa.
Nhấp chuột vào đây để mở rộng...
Sao các Thầy với các anh khó quá nói thế nào cũng bị lỗi, mà không nói thì bảo à thằng này nó nhờ mà không nói gì hết ai biết mà lần, huhu.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

C
Tải kết quả xổ số 3 miền về excel (3 người xem)
    • Thích
3 4 5
Trả lời
98
Đọc
13K
HNam_Phan
H
vnxgiokinhtoi
Nhờ giúp đỡ công thức lưu dữ liệu và mở lại dữ liệu cũ đã save (1 người xem)
Trả lời
3
Đọc
125
vnxgiokinhtoi
vnxgiokinhtoi
T
Nhờ ACE chỉ giáo công thức Gộp nhiều dữ liệu vào một ô trong excel
Trả lời
11
Đọc
271
Hoàng Tuấn 868
H
L
Xin giúp đỡ đổi màu chữ trong mathtype powerpoint sang màu đen (1 người xem)
Trả lời
1
Đọc
54
Hoàng Tuấn 868
H
PhanTuHuong
Nên chọn điện thoại nào? (1 người xem)
2
Trả lời
21
Đọc
1K
minhminh27
minhminh27
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
264
Đọc
28K
lilknighthood
L
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
9
Đọc
397
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Manhhung90
Tạo nút bấm để xoá nhanh trang trong file word.
Trả lời
3
Đọc
105
PhanTuHuong
PhanTuHuong
H
Hàm Evaluate bị lỗi khi mở lại
2
Trả lời
23
Đọc
294
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết (1 người xem)
    • Buồn
    • Cười
Trả lời
5
Đọc
230
SA_DQ
SA_DQ
Nguyễn Duy Tuân
Lập trình VBA với Google Drive, OneDrive, DropBox cho Upload-Download-Copy-Move...
    • Cảm ơn
    • Thích
Trả lời
4
Đọc
318
quyenpv
quyenpv
hungmanh.th1
Lỗi không trả về Giá trị 0 trong excel (1 người xem)
    • Cười
Trả lời
5
Đọc
79
hungmanh.th1
hungmanh.th1
HeSanbi
  • Question Question
VBA nâng cao: Nhúng tập tin vào trang tính hoặc trích xuất chúng nhanh chóng
    • Thích
    • Cảm ơn
Trả lời
0
Đọc
152
HeSanbi
HeSanbi
nguyễn tiến tú
file CALCULATING rất chậm em nhờ các anh chị xem giúp em ạ (1 người xem)
Trả lời
7
Đọc
391
tranhungdao12a3
T
T
  • Question Question
Xin thầy/cô và anh chị giúp đỡ cách điền thông tin ca kíp trực trong bảng Excel bằng VBA
Trả lời
2
Đọc
156
tiennd67
T
H
HELP! HÀM LẤY THÁNG/ NĂM TRONG EXCEL (1 người xem)
Trả lời
5
Đọc
137
ptm0412
ptm0412
H
Em hỏi vì sao khi file googlesheet của em thì code chạy (1 người xem)
Trả lời
2
Đọc
66
Hoale85
H
4
EXCEL TỰ ĐỘNG MỞ TRÊN WEB
Trả lời
9
Đọc
284
4545
4
H
Phân quyền xem trên từng trang tính của googlesheet (1 người xem)
Trả lời
6
Đọc
150
tranhungdao12a3
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
2 3
Trả lời
50
Đọc
14K
HeSanbi
HeSanbi
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom