Nhờ anh chị diễn đàn viết giúp code VBA lấy dữ liệu

[soap1234]

Xin chào anh chị em có bảng dữ liệu sau nhờ anh chị viết em code với nội dung sau với ạ
- Khi chọn [MADVHC] và nhập vào cột Diện tích ở sheet Nhap bấm code thì tự động lấy dữ liệu đơn giá từ sheet DonGia điền sang sheet nhap
- Căn cứ vào dòng tiêu đề ở 2 sheet để lấy dữ liệu
Em xinn cảm ơn anh chị

 

[SA_DQ]

Đại loại là vầy, xin mời bạn tiếp tục cho đến kết thúc:

Private Sub Worksheet_Change(ByVal Target As Range)
 Const SDg As Integer = 999
 Dim Gia As Double, DT As Double
 
 If Not Intersect(Target, Union([B3].Resize(SDg), [D3].Resize(SDg), [F3].Resize(SDg) _
    , [H3].Resize(SDg), [J3].Resize(SDg), [L3].Resize(SDg), [O3].Resize(SDg))) Is Nothing Then
    DT = Target.Value
    If Cells(Target.Row, "A").Value = "TT_TD" Then
        Gia = 1000 * Switch(DT < 100, 941.64, DT < 300, 300, DT < 500, 500, DT < 1000, 700, DT < 3000, 900 _
            , DT < 10000, 1100, DT < 100000, 1300, DT < 500000, 1500)
    ' . . . . .     '
 
    End If
 End If
End Sub

 

[soap1234]

Anh ơi nhờ anh viết cho em cái code tự bấm thôi anh à không theo kiểu Private Sub Worksheet_Change anh à . với lại khai báo địa chỉ ô B3.D3........thay bằng các ô ký tự tiêu đề như [Dtic<100], Dtich 100-300]......Em xin cảm ơn anh

 

[SA_DQ]

Trước tiên là xin lỗi bạn 2 thứ:
(1) Macro trên mình viết có chổ sai chính tả; Lý ra nó sẽ phải thế này:

Private Sub Worksheet_Change(ByVal Target As Range)
 Const SDg As Integer = 999
 Dim Gia As Double, DT As Double
 Dim MaDV As String
 Dim Rng As Range
 
 Set Rng = Union([B3].Resize(SDg), [D3].Resize(SDg), [F3].Resize(SDg) _
    , [H3].Resize(SDg), [J3].Resize(SDg), [L3].Resize(SDg), [O3].Resize(SDg))
 DT = Target.Value:                 MaDV = Cells(Target.Row, "A").Value
 If Not Intersect(Target, Rng) Is Nothing Then
    If MaDV = "TT-TD" Then
        Target.Offset(, 1).Value = 1000 * Switch(DT < 100, 941.64, DT < 300, 300, DT < 500, 500, DT < 1000, 700, DT < 3000, 900 _
            , DT < 10000, 1100, DT < 100000, 1300, DT < 500000, 1500)
    Else'If. . . . . . . . '
  ' * '* ' *' '* '
    End If
 End If
End Sub

(Cụ thể thay vì 'TT-TD' mình lại gà mờ viết 'TT_TD')

(2) Chưa nói rõ: Đó là macro sự kiện, bạn chép nó vô trang tính 'Nhap'

Theo mình, bạn xài macro sự kiện sẽ tiện & dễ hơn: Chỉ cần nhập trị trên bất kì ô nào (được bôi vàng) thì ô bên phải liền kề sẽ có trị tương ứng từ bảng biểu;
Chúc ngày cuối tuần vui vẻ!

 

[soap1234]

Dạ cảm ơn anh nhiều. Anh giúp em viết code như này không anh. Code tự bấm thôi anh à không theo kiểu Private Sub Worksheet_Change anh à . với lại khai báo địa chỉ ô B3.D3........thay bằng các ô ký tự tiêu đề như [Dtich<100], Dtich 100-300]....

 

[soap1234]

Vẫn lỗi anh à . Em Xin nhờ anh chuyển sang code em với, khai báo như bài #5 với ạ

 

[SA_DQ]

Anh ơi nhờ anh viết cho em cái code tự bấm thôi anh à không theo kiểu Private Sub Worksheet_Change anh à . với lại khai báo địa chỉ ô B3.D3........thay bằng các ô ký tự tiêu đề như [Dtic<100], Dtich 100-300]......Em xin cảm ơn anh

Bạn nào trong cộng đồng giúp bạn í theo đường hướng này đi vậy!
####@ ####@

 

[Hoàng Tuấn 868]

Bạn nào trong cộng đồng giúp bạn í theo đường hướng này đi vậy!
####@ ####@

Em cũng định xem thử thế nào, nhưng đọc mấy câu "ban phước", "đội ơn" em thấy mình chưa đủ khả năng để "ban phước" và làm cho người ta phải "đội ơn" nên lại kê dép ngồi xem.

 

[soap1234]

Mong các anh xem giúp sửa cho em về code tự bấm thôi không thay đổi theo sự kiện em xin cảm ơn ạ

 

[SA_DQ]

Mong các anh xem giúp sửa cho em về code tự bấm thôi không thay đổi theo sự kiện em xin cảm ơn ạ

Bạn nên giải thích nhóm từ 'code tự bấm' là như thế nào, để cộng đồng (ngoài mình) được hiểu rõ hơn được chăng?

 

[soap1234]

Dạ nhờ anh viết em code như này anh à
Sub ()

End Sub

 

[soap1234]

Anh xem lại em với khi thay đổi giá trị ô thì báo lỗi như bài 6 anh à

 

[SA_DQ]

Anh xem lại em với khi thay đổi giá trị ô thì báo lỗi như bài 6 anh à

Vậy bạn đem dòng lệnh đang tô vàng (báo lỗi) xuống dưới dòng lệnh hiện đang bên dưới 'chúng'

 

[soap1234]

Dạ được rồi anh ạ nhưng sao không thực hiện được Ctrl +Z được anh nhỉ . Anh xem có thể chuyển sang code cho em với. cảm ơn anh nhiều

 

[soap1234]

Các anh chị ơi anh sa_DQ ơi nhờ các anh các chị sửa em code trên với.

 

[bebo021999]

Sheet Nhap thiếu 1 cột "[Dtich 1 ha – 10 ha]"
Sheet "DonGia" ô G1 sửa "[TTien-TĐ 3000-10000m2]" thành "[Gia-TĐ 3000-10000m2]"
Test thử:

Option Explicit
Sub DonGia()
Dim lr&, i&, j&, rng1 As Range, rng2
With Worksheets("DonGia")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    Set rng1 = .Range("A1:I" & lr)
End With
With Worksheets("Nhap")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    rng2 = .Range("A2:P" & lr).Value
    For i = 2 To lr - 1
        For j = 3 To 16 Step 2
            rng2(i, j) = ""
            With WorksheetFunction
                If rng2(i, j - 1) > 0 Then rng2(i, j) = .Index(rng1, .Match(rng2(i, 1), rng1.Columns(1), 0), .Match(rng2(1, j), rng1.Rows(1), 0))
            End With
        Next
    Next
.Range("A2").Resize(UBound(rng2), UBound(rng2, 2)).Value = rng2
End With
End Sub

 

[soap1234]

Em cảm ơn anh nhiều nhờ anh sửa lại chỗ
- Cột [Gia-TĐ 10 ha – 50 ha] không ra kết quả anh à
- Bảng nhập em có xóa 1 dòng trống cho đồng bộ ạ

 

[BuiQuangThuan]

Em cũng định xem thử thế nào, nhưng đọc mấy câu "ban phước", "đội ơn" em thấy mình chưa đủ khả năng để "ban phước" và làm cho người ta phải "đội ơn" nên lại kê dép ngồi xem.

Định mò mà thấy anh này nói thế này nên lại rén

 

[bebo021999]

Em cảm ơn anh nhiều nhờ anh sửa lại chỗ
- Cột [Gia-TĐ 10 ha – 50 ha] không ra kết quả anh à
- Bảng nhập em có xóa 1 dòng trống cho đồng bộ ạ

Kiểm tra lại xem được chưa?

 

[soap1234]

Dạ Em xin cảm ơn anh, anh chị GPE code đúng với bài toán em rồi chúc anh có nhiều điều tốt đẹp trong cuộc sống.