Giúp đỡ em về cách lấy dữ liệu từ 2 bảng dữ liệu (1 người xem)

[giahuyks93]

Giúp đỡ e về cách lấy dữ liệu từ 2 bảng dữ liệu

Em có 2 Bảng dữ liệu 1 là Bảng Kích Thước Ô Sàn Và Bảng Tỏng Tải Tính Toán
Và 2 Bảng Nhận dữ liệu Gồm bang Tính Toán Cốt Thép Bản Dầm Và Bảng Tính Toán Cốt Thép Bản Kê

Vấn đề e muốn hỏi là :
Ví dụ như Ô sàn S7 bên cột Phân loại là Bản Dầm thì dữ kiện của S7 bên Bảng Tổng Tải Tính Toán sẽ dc nhập vào các ô tương ứng của Bảng Tính Toán Cốt Thép Bản Dầm ( Dữ Kiện được gán qua ô được tô màu đỏ ở bảng Tổng tải tính toán)

Tương tự là nếu là bản kê thì sẽ tra dữ liệu vào Tính Toán Cốt Thép Bản Kê
Mong các a/c giúp đỡ

 

[HieuCD]

bạn ghi rỏ kết quả nằm ở ô nào trong bảng thứ 3 và 4, và dữ liệu có nhiều không

 

[giahuyks93]

Vâng anh ,Dữ liệu nằm ở Bang thứ 3 và thứ 4 ở ô e có tô màu xám xám . Dữ liệu lấy qua là bao gôm các hàng chữ đỏ ở bảng số 2 và điều kiện nằm ở bảng số 1

 

[HieuCD]

Vâng anh ,Dữ liệu nằm ở Bang thứ 3 và thứ 4 ở ô e có tô màu xám xám . Dữ liệu lấy qua là bao gôm các hàng chữ đỏ ở bảng số 2 và điều kiện nằm ở bảng số 1

bảng 3 và 4 chỉ tô có 1 dòng vậy chỉ lấy 1 dòng?

 

[nghiaphuc]

bảng 3 và 4 chỉ tô có 1 dòng vậy chỉ lấy 1 dòng?

Tôi hiểu là: Bảng 3 sẽ lấy những dữ liệu trên bảng 2 ứng với các ô sàn thuộc phân loại là Bản Dầm (S6 và S7), còn trên bảng 4 sẽ lấy dữ liệu của các ô sàn thuộc phân loại là Bản Kê (S1 --> S5, S8, S9)

 

[giahuyks93]

Vâng anh .Lấy đúng 1 dòng nhưng chạy theo điều kiện ở Bảng số 1
E lấy S7 ở ô phân loại Bảng 1 là bản dầm thì dữ liệu sẽ dc lấy qua Bảng số 3 là tính toán cốt thép bản dầm ( dữ kiện là ở dòng tương tự của S7 ở Bảng 2) và tương tụ nếu bản kê thì nó bay qua Bảng số 4 .Em cám ơn a

 

[HieuCD]

Vâng anh .Lấy đúng 1 dòng nhưng chạy theo điều kiện ở Bảng số 1
E lấy S7 ở ô phân loại Bảng 1 là bản dầm thì dữ liệu sẽ dc lấy qua Bảng số 3 là tính toán cốt thép bản dầm ( dữ kiện là ở dòng tương tự của S7 ở Bảng 2) và tương tụ nếu bản kê thì nó bay qua Bảng số 4 .Em cám ơn a

nhưng tại sao không lấy S6 cho vào bảng 3

 

[giahuyks93]

có chứ anh ý e là e lấy vd về cách lấy thui chứ nó sẽ lọc như anh Nghĩa Phúc nói "Bảng 3 sẽ lấy những dữ liệu trên bảng 2 ứng với các ô sàn thuộc phân loại là Bản Dầm (S6 và S7), còn trên bảng 4 sẽ lấy dữ liệu của các ô sàn thuộc phân loại là Bản Kê (S1 --> S5, S8, S9)"

 

[HieuCD]

bạn xem được chưa, để ý số 40 và 56 là dòng của số thứ tự 1

 

[giahuyks93]

em cám ơn a Nhưng mà e định viết 1 cái code như trong file này . Do khả năng của e hạn chế e không thể triển khai tiếp mong mọi người xem xét giúp e

 

[nghiaphuc]

em cám ơn a Nhưng mà e định viết 1 cái code như trong file này . Do khả năng của e hạn chế e không thể triển khai tiếp mong mọi người xem xét giúp e

Chắc là code thế này:
[GPECODE=vb]Sub TraBang()
Dim i As Long, d As Long, k As Long, Tmp, ArrD(), ArrK()
Tmp = [D2230]
ReDim ArrD(1 To UBound(Tmp) * 4, 1 To 5)
ReDim ArrK(1 To UBound(Tmp) * 4, 1 To 5)
For i = 1 To UBound(Tmp)
If Mid([E6:E14].Find(Tmp(i, 1), , , xlWhole).Offset(, 4), 5, 1) = "D" Then
d = d + 1
ArrD((d - 1) * 4 + 1, 1) = d 'STT
ArrD((d - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrD((d - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrD((d - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrD((d - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
Else
k = k + 1
ArrK((k - 1) * 4 + 1, 1) = k 'STT
ArrK((k - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrK((k - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrK((k - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrK((k - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
End If
Next
[D40:H40].Resize((d - 1) * 4 + 1) = ArrD
[D56:H56].Resize((k - 1) * 4 + 1) = ArrK
End Sub[/GPECODE]

 

[giahuyks93]

Chắc là code thế này:
[GPECODE=vb]Sub TraBang()
Dim i As Long, d As Long, k As Long, Tmp, ArrD(), ArrK()
Tmp = [D2230]
ReDim ArrD(1 To UBound(Tmp) * 4, 1 To 5)
ReDim ArrK(1 To UBound(Tmp) * 4, 1 To 5)
For i = 1 To UBound(Tmp)
If Mid([E6:E14].Find(Tmp(i, 1), , , xlWhole).Offset(, 4), 5, 1) = "D" Then
d = d + 1
ArrD((d - 1) * 4 + 1, 1) = d 'STT
ArrD((d - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrD((d - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrD((d - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrD((d - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
Else
k = k + 1
ArrK((k - 1) * 4 + 1, 1) = k 'STT
ArrK((k - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrK((k - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrK((k - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrK((k - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
End If
Next
[D40:H40].Resize((d - 1) * 4 + 1) = ArrD
[D56:H56].Resize((k - 1) * 4 + 1) = ArrK
End Sub[/GPECODE]

Em cám ơn a nhiều lắm

 

[giahuyks93]

a Nghĩa Phúc . Cho e hỏi ở những phần như Tmp = [D2230] ,[E6:E14], [D40:H40] ,[D56:H56] .Mình có thể đặt cho nó 1 cái Name range , rồi gán name range vào nhữn vùng đó có được không anh ? Em thủ đặt bị lỗi .Mong anh xem xét giúp em

Sub TraBang() Dim i As Long, d As Long, k As Long, Tmp, Abm, ArrD(), ArrK()
Dim Rang1 As Range
Dim Rang2 As Range
Dim Rang3 As Range
Dim Rang4 As Range
Dim Rang5 As Range
Dim Rang6 As Range


Set Rang1 = Range("A1:A1000").Find("22", , xlValues, xlWhole, , , True)
Set Rang2 = Range("A1:A1000").Find("30", , xlValues, xlWhole, , , True)

Set Rang3 = Range("A1:A1000").Find("6", , xlValues, xlWhole, , , True)
Set Rang4 = Range("A1:A1000").Find("14", , xlValues, xlWhole, , , True)

Set Rang5 = Range("A1:A1000").Find("40", , xlValues, xlWhole, , , True)
Set Rang6 = Range("A1:A1000").Find("56", , xlValues, xlWhole, , , True)

Tmp = Range(Rang1.Offset(, 3), Rang2.Offset(, 15)).Value2
Abm = Range(Rang3.Offset(, 4), Rang4.Offset(, 4))

ReDim ArrD(1 To UBound(Tmp) * 4, 1 To 5)
ReDim ArrK(1 To UBound(Tmp) * 4, 1 To 5)
For i = 1 To UBound(Tmp)
If Mid(Abm.Find(Tmp(i, 1), , , xlWhole).Offset(, 4), 5, 1) = "D" Then
d = d + 1
ArrD((d - 1) * 4 + 1, 1) = d 'STT
ArrD((d - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrD((d - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrD((d - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrD((d - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
Else
k = k + 1
ArrK((k - 1) * 4 + 1, 1) = k 'STT
ArrK((k - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrK((k - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrK((k - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrK((k - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
End If
Next
Range(Rang5.Offset(, 3), Rang5.Offset(, 7)).Value2.Resize((d - 1) * 4 + 1) = ArrD
Range(Rang6.Offset(, 3), Rang4.Offset(, 7)).Value2.Resize((k - 1) * 4 + 1) = ArrK
End Sub

 

[nghiaphuc]

a Nghĩa Phúc . Cho e hỏi ở những phần như Tmp = [D2230] ,[E6:E14], [D40:H40] ,[D56:H56] .Mình có thể đặt cho nó 1 cái Name range , rồi gán name range vào nhữn vùng đó có được không anh ? Em thủ đặt bị lỗi .Mong anh xem xét giúp em

Bạn tự so sánh code này với code của bạn (thật kỹ) để tìm ra vấn đề nhé:
[GPECODE=vb]Sub TraBang()
Dim i As Long, d As Long, k As Long, Tmp, Abm As Range, ArrD(), ArrK()
Dim Rang1 As Range, Rang2 As Range, Rang3 As Range, Rang4 As Range, Rang5 As Range, Rang6 As Range

Set Rang1 = Range("A1:A1000").Find("22", , xlValues, xlWhole, , , True)
Set Rang2 = Range("A1:A1000").Find("30", , xlValues, xlWhole, , , True)

Set Rang3 = Range("A1:A1000").Find("6", , xlValues, xlWhole, , , True)
Set Rang4 = Range("A1:A1000").Find("14", , xlValues, xlWhole, , , True)

Set Rang5 = Range("A1:A1000").Find("40", , xlValues, xlWhole, , , True)
Set Rang6 = Range("A1:A1000").Find("56", , xlValues, xlWhole, , , True)

Tmp = Range(Rang1.Offset(, 3), Rang2.Offset(, 15)).Value2
Set Abm = Range(Rang3.Offset(, 4), Rang4.Offset(, 4))

ReDim ArrD(1 To UBound(Tmp) * 4, 1 To 5)
ReDim ArrK(1 To UBound(Tmp) * 4, 1 To 5)
For i = 1 To UBound(Tmp)
If Mid(Abm.Find(Tmp(i, 1), , , xlWhole).Offset(, 4), 5, 1) = "D" Then
d = d + 1
ArrD((d - 1) * 4 + 1, 1) = d 'STT
ArrD((d - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrD((d - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrD((d - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrD((d - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
Else
k = k + 1
ArrK((k - 1) * 4 + 1, 1) = k 'STT
ArrK((k - 1) * 4 + 1, 2) = Tmp(i, 1) 'O san
ArrK((k - 1) * 4 + 1, 3) = Tmp(i, 6) 'L1
ArrK((k - 1) * 4 + 1, 4) = Tmp(i, 7) 'L2
ArrK((k - 1) * 4 + 1, 5) = Tmp(i, 13) 'q
End If
Next
Range(Rang5.Offset(, 3), Rang5.Offset(, 7)).Resize((d - 1) * 4 + 1) = ArrD
Range(Rang6.Offset(, 3), Rang6.Offset(, 7)).Resize((k - 1) * 4 + 1) = ArrK
End Sub[/GPECODE]