Các Anh Chị Giúp Em Chỉnh Sủa Lại Code Lọc Dữ Liệu (1 người xem)

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

giahuyks93

Thành viên mới
Tham gia
24/10/15
Bài viết
34
Được thích
0
Vấn Đề Của Em là :
Dữ Liệu ban Đầu Gồm Có 4 Cột Nhu trong excel :
Em đã lọc ra được vị trí lớn nhất tương ứng với các tầng cột tương ứng . Tại các cột K , L ,M

Em muốn hỏi là làm sao e thế ngược các giá trị đó vào ô vị trí tương ứng . Cột M thế vào Cột D .

Vd STORY5 C5 TT 0 ( ĐỔI THÀNH 0.68 ) . Mong Các A/chi giúp đỡ em.

Nếu A/c nào có cách viết code hay hơn góp ý . em xin nhận ạ
 

File đính kèm

Em muốn hỏi là làm sao e thế ngược các giá trị đó vào ô vị trí tương ứng . Cột M thế vào Cột D .

Vd STORY5 C5 TT 0 ( ĐỔI THÀNH 0.68 ) . Mong Các A/chi giúp đỡ em.

Xem file đính kèm. Tôi làm trên cột E. Hãy copy value cột E sang cột D

Tôi có thêm cột j (tầngcột)
 

File đính kèm

Vấn Đề Của Em là :
Dữ Liệu ban Đầu Gồm Có 4 Cột Nhu trong excel :
Em đã lọc ra được vị trí lớn nhất tương ứng với các tầng cột tương ứng . Tại các cột K , L ,M

Em muốn hỏi là làm sao e thế ngược các giá trị đó vào ô vị trí tương ứng . Cột M thế vào Cột D .

Vd STORY5 C5 TT 0 ( ĐỔI THÀNH 0.68 ) . Mong Các A/chi giúp đỡ em.

Nếu A/c nào có cách viết code hay hơn góp ý . em xin nhận ạ

Bạn thử chạy Sub này không cần chạy Sub LayChieuCaoCot() của bạn.
Kết quả tôi tạm gán vào cột F, bạn tuỳ chỉnh.
PHP:
Public Sub GPE_MAX()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("A6", Range("A6").End(xlDown)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1) & sArr(I, 2)
    If Abs(sArr(I, 4)) > Dic.Item(Tem) Then Dic.Item(Tem) = Abs(sArr(I, 4))
Next I
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1) & sArr(I, 2)
    dArr(I, 1) = Dic.Item(Tem)
Next I
Range("F6").Resize(I - 1) = dArr    '<-----Gan vao cot F'
Set Dic = Nothing
End Sub
 
Bạn thử chạy Sub này không cần chạy Sub LayChieuCaoCot() của bạn.
Kết quả tôi tạm gán vào cột F, bạn tuỳ chỉnh.
PHP:
Public Sub GPE_MAX()
Dim Dic As Object, sArr(), dArr(), I As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range("A6", Range("A6").End(xlDown)).Resize(, 4).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1) & sArr(I, 2)
    If Abs(sArr(I, 4)) > Dic.Item(Tem) Then Dic.Item(Tem) = Abs(sArr(I, 4))
Next I
For I = 1 To UBound(sArr)
    Tem = sArr(I, 1) & sArr(I, 2)
    dArr(I, 1) = Dic.Item(Tem)
Next I
Range("F6").Resize(I - 1) = dArr    '<-----Gan vao cot F'
Set Dic = Nothing
End Sub
Hay quá .Em cám ơn a
 

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

Back
Top Bottom