Giúp đỡ code về cơ sở dữ liệu

[customs45]

Em có file như sau muốn được thầy cô, anh chị và các bạn giúp đỡ:em có 3 cột dữ liệu. Cột 1 có mấy trăm dòng, cột 2, và cột 3 có mấy chục dòng dữ liệu bài toán của em làsử dụng cách nào đó để mỗi giá trị ở cột 1 sẽ đi kèm với lần lượt từng giá trị trong cột 2 và cột 3!File ví dụ của em như sau:Sheet: nguon là file ban đầu và em muốn được như sheet ket quaanh chị và các bạn xem file đính kèm và giúp đỡ em với ạ!Cảm ơn các anh chị rất nhiều!

 

[Cá ngừ F1]

File đính kèm đâu bạn

 

[customs45]

em xin phép chèn file anh chị xem giùm ạ!

 

[sealand]

Cái này dùng VBA thì cũng không có vấn đề gì. Nhưng chỉ cần chuyển lấy dữ liệu 1 lần thì ta có thể dùng công thức như sau là ổn:

Cứ cọi vị trí dữ liệu như trên file ví dụ nha.

Tại ô E1 ta nhập công thức:=INDEX($A$4:$A$13,1+INT((ROW(1:1)-1)/COUNTA($B$4:$B$100)))

Tại ô F1 ta nhập Công thức: =INDEX($B$4:$B$8,MOD(ROW(1:1)-1,COUNTA($B$4:$B$100))+1)

Tại ô G1 ta nhập công thức:=INDEX($C$4:$C$8,MOD(ROW(1:1)-1,COUNTA($B$4:$B$100))+1)

Ta filldow công thức xuống đến dòng (Số dòng cột 1 * Số dòng cột 2) hoặc cứ kéo xuống bao giờ cột E lỗi thì thôi. Kết quả là cái bạn cần

Nếu thích dùng Code thì đây là Code bạn tham khảo:

Sub MakeDT()
Dim Kq(), Tm1, Tm2, i, j, n
Tm1 = Sheet1.[A4].Resize(Sheet1.[A65536].End(3).Row - 3)
Tm2 = Sheet1.[B4:C4].Resize(Sheet1.[B65536].End(3).Row - 3)
ReDim Kq(1 To UBound(Tm1, 1) * 3, 1 To 3)
For i = 1 To UBound(Tm1, 1)
For j = 1 To UBound(Tm2, 1)
n = n + 1
Kq(n, 1) = Tm1(i, 1)
Kq(n, 2) = Tm2(j, 1)
Kq(n, 3) = Tm2(j, 2)
Next j
Next i
Sheet1.[E1].Resize(n,3) = Kq
End Sub

 

[comet_1701]

Cái này dùng VBA thì cũng không có vấn đề gì. Nhưng chỉ cần chuyển lấy dữ liệu 1 lần thì ta có thể dùng công thức như sau là ổn:

Cứ cọi vị trí dữ liệu như trên file ví dụ nha.

Tại ô E1 ta nhập công thức:=INDEX($A$4:$A$13,1+INT((ROW(1:1)-1)/COUNTA($B$4:$B$100)))

Tại ô F1 ta nhập Công thức: =INDEX($B$4:$B$8,MOD(ROW(1:1)-1,COUNTA($B$4:$B$100))+1)

Tại ô G1 ta nhập công thức:=INDEX($C$4:$C$8,MOD(ROW(1:1)-1,COUNTA($B$4:$B$100))+1)

Ta filldow công thức xuống đến dòng (Số dòng cột 1 * Số dòng cột 2) hoặc cứ kéo xuống bao giờ cột E lỗi thì thôi. Kết quả là cái bạn cần

Nếu thích dùng Code thì đây là Code bạn tham khảo:

Sub MakeDT()
Dim Kq(), Tm1, Tm2, i, j, n
Tm1 = Sheet1.[A4].Resize(Sheet1.[A65536].End(3).Row - 3)
Tm2 = Sheet1.[B4:C4].Resize(Sheet1.[B65536].End(3).Row - 3)
ReDim Kq(1 To UBound(Tm1, 1) * 3, 1 To 3)
For i = 1 To UBound(Tm1, 1)
For j = 1 To UBound(Tm2, 1)
n = n + 1
[COLOR=#b22222]Kq(n, 1) = Tm1(i, 1)[/COLOR]
Kq(n, 2) = Tm2(j, 1)
Kq(n, 3) = Tm2(j, 2)
Next j
Next i
Sheet1.[E1].Resize(n,3) = Kq
End Sub

Báo ngoài vùng anh Sealand ah, out of range ( ở phần màu đỏ)

 

[sealand]

Code goc của nó thế này, nhưng dữ liệu cho cố định 3 cột mình sửa ngay trên Forum nên không soát được.

Sub MakeDT()
Dim Kq(), Tm1, Tm2, i, j, n
Tm1 = Sheet1.[A4].Resize(Sheet1.[A65536].End(3).Row - 3)
Tm2 = Sheet1.[B4:C4].Resize(Sheet1.[B65536].End(3).Row - 3)
ReDim Kq(1 To UBound(Tm1, 1) * UBound(Tm2, 1), 1 To UBound(Tm1, 2) + UBound(Tm2, 2))
For i = 1 To UBound(Tm1, 1)
For j = 1 To UBound(Tm2, 1)
n = n + 1
Kq(n, 1) = Tm1(i, 1)
Kq(n, 2) = Tm2(j, 1)
Kq(n, 3) = Tm2(j, 2)
Next j
Next i
Sheet1.[G1].Resize(n, UBound(Kq, 2)) = Kq
End Sub

Nó sai ở đây:

ReDim Kq(1 To UBound(Tm1, 1) * 3, 1 To 3)

Phải sửa thành:

ReDim Kq(1 To UBound(Tm1, 1) * UBound(Tm2, 1), 1 To 3)

Thông cảm nha.

 

[customs45]

Cái này dùng VBA thì cũng không có vấn đề gì. Nhưng chỉ cần chuyển lấy dữ liệu 1 lần thì ta có thể dùng công thức như sau là ổn:

Cứ cọi vị trí dữ liệu như trên file ví dụ nha.

Tại ô E1 ta nhập công thức:=INDEX($A$4:$A$13,1+INT((ROW(1:1)-1)/COUNTA($B$4:$B$100)))

Tại ô F1 ta nhập Công thức: =INDEX($B$4:$B$8,MOD(ROW(1:1)-1,COUNTA($B$4:$B$100))+1)

Tại ô G1 ta nhập công thức:=INDEX($C$4:$C$8,MOD(ROW(1:1)-1,COUNTA($B$4:$B$100))+1)

Ta filldow công thức xuống đến dòng (Số dòng cột 1 * Số dòng cột 2) hoặc cứ kéo xuống bao giờ cột E lỗi thì thôi. Kết quả là cái bạn cần

Nếu thích dùng Code thì đây là Code bạn tham khảo:

Sub MakeDT()
Dim Kq(), Tm1, Tm2, i, j, n
Tm1 = Sheet1.[A4].Resize(Sheet1.[A65536].End(3).Row - 3)
Tm2 = Sheet1.[B4:C4].Resize(Sheet1.[B65536].End(3).Row - 3)
ReDim Kq(1 To UBound(Tm1, 1) * 3, 1 To 3)
For i = 1 To UBound(Tm1, 1)
For j = 1 To UBound(Tm2, 1)
n = n + 1
Kq(n, 1) = Tm1(i, 1)
Kq(n, 2) = Tm2(j, 1)
Kq(n, 3) = Tm2(j, 2)
Next j
Next i
Sheet1.[E1].Resize(n,3) = Kq
End Sub

Cảm ơn Sealand nhiều nha! cái công thức dùng được hàm Index mình cũng hay dùng mà thực sự không biết đến thuật toán trong trường hợp này thế nào
Còn cái code hình như bị lỗi thì phải?
VBA thì em mù, có bác nào có ý kiến giống em ko? hôm qua thử mãi không được

 

[comet_1701]

Cảm ơn Sealand nhiều nha! cái công thức dùng được hàm Index mình cũng hay dùng mà thực sự không biết đến thuật toán trong trường hợp này thế nào
Còn cái code hình như bị lỗi thì phải?
VBA thì em mù, có bác nào có ý kiến giống em ko? hôm qua thử mãi không được

Sub MakeDT()
Dim Kq(), Tm1, Tm2, i, j, n
Tm1 = Sheet1.[A4].Resize(Sheet1.[A65536].End(3).Row - 3)
Tm2 = Sheet1.[B4:C4].Resize(Sheet1.[B65536].End(3).Row - 3)
ReDim Kq(1 To UBound(Tm1, 1) * UBound(Tm2, 1), 1 To UBound(Tm1, 2) + UBound(Tm2, 2))
For i = 1 To UBound(Tm1, 1)
For j = 1 To UBound(Tm2, 1)
n = n + 1
Kq(n, 1) = Tm1(i, 1)
Kq(n, 2) = Tm2(j, 1)
Kq(n, 3) = Tm2(j, 2)
Next j
Next i
Sheet1.[G1].Resize(n, UBound(Kq, 2)) = Kq
End Sub

Bạn dùng code này nhé
Kết quả ra ở G1 sheet nguồn nhé

 

[customs45]

vậy mở rộng bài toán nhóm 1 có thêm 3 cột và nhóm 2 có thêm 3 cột, thuật toán vẫn tương tự thì code được sửa thành thế nào nhỉ?
Mong các bác chỉ giáo ạ!

 

[comet_1701]

vậy mở rộng bài toán nhóm 1 có thêm 3 cột và nhóm 2 có thêm 3 cột, thuật toán vẫn tương tự thì code được sửa thành thế nào nhỉ?
Mong các bác chỉ giáo ạ!

Sub MakeDT()
Dim Kq(), Tm1, Tm2, i, j, n
Tm1 = Sheet1.[A4:D4].Resize(Sheet1.[A65536].End(3).Row - 3)
Tm2 = Sheet1.[E4:I4].Resize(Sheet1.[E65536].End(3).Row - 3)
ReDim Kq(1 To UBound(Tm1, 1) * UBound(Tm2, 1), 1 To UBound(Tm1, 2) + UBound(Tm2, 2))
For i = 1 To UBound(Tm1, 1)
For j = 1 To UBound(Tm2, 1)
n = n + 1
Kq(n, 1) = Tm1(i, 1)
Kq(n, 2) = Tm1(i, 2)
Kq(n, 3) = Tm1(i, 3)
Kq(n, 4) = Tm1(i, 4)
Kq(n, 5) = Tm2(j, 1)
Kq(n, 6) = Tm2(j, 2)
Kq(n, 7) = Tm2(j, 3)
Kq(n, 8) = Tm2(j, 4)
Next j
Next i
Sheet1.[L1].Resize(n, UBound(Kq, 2)) = Kq
End Sub

Mình thử thôi, ko biết có đúng ý bạn ko