Xin giúp code VBA tự động kéo công thức

ditimdl · 31/10/13

Mình có bảng dữ liệu: cột A, cột B nhập dữ liệu, cột C và D thì công thức
Mình muốn khi nhập dữ liệu bên cột A thì công thức cột C và D tự động kéo theo.
Các bạn giúp mình code này với.
Cảm ơn!

vu_tuan_manh_linh · 31/10/13

ditimdl đã viết:
Mình có bảng dữ liệu: cột A, cột B nhập dữ liệu, cột C và D thì công thức
Mình muốn khi nhập dữ liệu bên cột A thì công thức cột C và D tự động kéo theo.
Các bạn giúp mình code này với.
Cảm ơn!

Đoạn code thế này nhé!

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column = 1 Then
    Range("C" & Target.Row).Select
    Selection.FillDown
    Range("B" & Target.Row).Select
End If
If Target.Column = 2 Then
    Range("D" & Target.Row).Select
    Selection.FillDown
End If
Application.ScreenUpdating = True
End Sub

ditimdl · 31/10/13

Cảm ơn bạn.
Nếu gọp lại thì như thế nào? Khi nhập dữ liệu vào cột A nó sẽ filldown cột C và D luôn?

leonguyenz · 31/10/13

ditimdl đã viết:
Cảm ơn bạn.
Nếu gọp lại thì như thế nào? Khi nhập dữ liệu vào cột A nó sẽ filldown cột C và D luôn?

Có thể sử dụng Code sau:
[gpecode=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Range("A2:A1000"), Target) Is Nothing Then
Target.Offset(, 2).Resize(, 2).FillDown
End If
Application.ScreenUpdating = True
End Sub
[/gpecode]

vu_tuan_manh_linh · 31/10/13

ditimdl đã viết:
Cảm ơn bạn.
Nếu gọp lại thì như thế nào? Khi nhập dữ liệu vào cột A nó sẽ filldown cột C và D luôn?

Cái này đơn giản thôi mà bạn!! Cố gắng đọc code một chút là hiểu thôi!

ditimdl · 31/10/13

vu_tuan_manh_linh đã viết:
Cái này đơn giản thôi mà bạn!! Cố gắng đọc code một chút là hiểu thôi!

Hì code mình có biết gì mấy đâu, hơn nữa mấy năm nay không đụng đến giờ nhìn vào thấy cái gì cũng lạ

Ba Tê · 1/11/13

leonguyenz đã viết:
Có thể sử dụng Code sau:
[gpecode=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Range("A2:A1000"), Target) Is Nothing Then
Target.Offset(, 2).Resize(, 2).FillDown
End If
Application.ScreenUpdating = True
End Sub
[/gpecode]

Ai da! Leonguyenz đã bước chân vào "con đường đau khổ" rồi hé.
Góp thêm một code với Leo để "thêm đau khổ" một chút coi sao.
Hổng nói chuyện nhanh chậm à nghe, chỉ là nó có khác khác một chút thôi.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    If Not Intersect(Range("A2:A1000"), Target) Is Nothing Then
        [C2:D2].Copy Target.Offset(, 2).Resize(, 2)
    End If
Application.ScreenUpdating = True
End Sub

lysamtanhaccs4 · 2/11/13

chuyển filldown thành paste công thức vô luôn dc ko bác ?

vu_tuan_manh_linh · 4/11/13

lysamtanhaccs4 đã viết:
chuyển filldown thành paste công thức vô luôn dc ko bác ?

Thay vì dùng 1 câu lệnh filldown, bạn lại muốn đẻ thêm câu lệnh copy - paste nữa sao!!

lysamtanhaccs4 · 4/11/13

vu_tuan_manh_linh đã viết:
Thay vì dùng 1 câu lệnh filldown, bạn lại muốn đẻ thêm câu lệnh copy - paste nữa sao!!

Ý mình là công thức để trong code luôn không cần để công thức trên hàng đầu tiên

leonguyenz · 4/11/13

lysamtanhaccs4 đã viết:
Ý mình là công thức để trong code luôn không cần để công thức trên hàng đầu tiên

Bạn thử code này xem:
[gpecode=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Range("A2:A1000"), Target) Is Nothing Then
Target.Offset(, 2) = Application.WorksheetFunction.VLookup(Target, Sheet2.Range("A2:B4"), 2, False)
Target.Offset(, 3).Formula = "=RC[-2]*RC[-1]"
End If
Application.ScreenUpdating = True
End Sub
[/gpecode]
Cần Value giá trị luôn không, hay để hàm như vậy?

Quang_Hải · 4/11/13

leonguyenz đã viết:
Bạn thử code này xem:
[gpecode=vb]
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Range("A2:A1000"), Target) Is Nothing Then
Target.Offset(, 2) = Application.WorksheetFunction.VLookup(Target, Sheet2.Range("A2:B4"), 2, False)
Target.Offset(, 3).Formula = "=RC[-2]*RC[-1]"
End If
Application.ScreenUpdating = True
End Sub
[/gpecode]
Cần Value giá trị luôn không, hay để hàm như vậy?

Thay câu dùng hàm VlookUp bằng cái này gọn hơn

Mã:

Target(, 3) = Sheet2.[A:A].Find(Target, , , 1).Offset(, 1)

lysamtanhaccs4 · 4/11/13

quanghai1969 đã viết:
Thay câu dùng hàm VlookUp bằng cái này gọn hơn

Mã:

Target(, 3) = Sheet2.[A:A].Find(Target, , , 1).Offset(, 1)

mình có mấy công thức như sau vậy đổi code như thế náo nhé (phần chữ đỏ tô đậm)
code mình viết hơi gà lên các Pro cứ góp ý.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column = 3 Then
Range("A" & Target.Row).Select
Selection.FillDown (=IF($C5="","",$D$2))
Range("B" & Target.Row).Select
Selection.FillDown (=IF($C5="","",$G$2))
Range("M" & Target.Row).Select
Selection.FillDown (=IFERROR(WEEKNUM(A5),""))
Range("D" & Target.Row).Select
End If
If Target.Column = 4 Then
Range("K" & Target.Row).Select
Selection.FillDown (=IFERROR(IF(D5="","",VLOOKUP(D5,ARTTKT!$G:$I,3,0)),"MSNV Không có hoặc nhập sai"))
Range("J" & Target.Row).Select
Selection.FillDown (=IFERROR(IF(G5="",I5*VLOOKUP(LEFT(VLOOKUP(TEXT($C5,0),Release!A:B,2,0),7),ARTTKT!A:B,2,0),G5*VLOOKUP(LEFT(VLOOKUP(TEXT($C5,0),Release!A:B,2,0),7),ARTTKT!A:B,2,0))/10000,"")
Range("E" & Target.Row).Select
End If
If Target.Column = 8 Then
Range("L" & Target.Row).Select
Selection.FillDown
Range("I" & Target.Row).Select
End If
If Target.Column = 5 Then
Target.Offset(0, 1).Select
End If
If Target.Column = 6 Then
Target.Offset(0, 1).Select
End If
If Target.Column = 7 Then
Target.Offset(0, 1).Select
End If
If Target.Column = 9 Then
Target.Offset(1, -6).Select
End If
Application.ScreenUpdating = True
End Sub

lysamtanhaccs4 · 23/11/13

sao không thấy ai trả lời hết nhỉ ??

Quang_Hải · 23/11/13

lysamtanhaccs4 đã viết:
sao không thấy ai trả lời hết nhỉ ??

Thường những bài hỏi không có file kèm theo thì khó biết cách để trả lời cho đúng ý, nên mọi người cũng hơi lười hơn chút

hothanhlam.leok · 29/9/20

mình cũng có 1 trường hợp cần kéo công thức bằng VBA
bên dưới là file đính kèm
Khi U1>U2, thì các công thức ở cột P, Q, R sẽ kéo xuống tới hàng như giá trị của U1 (kiểu update thông tin)
Mong các Huynh giúp đỡ

phulien1902 · 29/9/20

hothanhlam.leok đã viết:
mình cũng có 1 trường hợp cần kéo công thức bằng VBA
bên dưới là file đính kèm
Khi U1>U2, thì các công thức ở cột P, Q, R sẽ kéo xuống tới hàng như giá trị của U1 (kiểu update thông tin)
Mong các Huynh giúp đỡ

Bạn giải thích hơi khó hiểu. Khi giá trị U1>U2 thì cần Filldown cột nào?

hothanhlam.leok · 29/9/20

phulien1902 đã viết:
Bạn giải thích hơi khó hiểu. Khi giá trị U1>U2 thì cần Filldown cột nào?

khi U1>U2 thì filldown cột P, Q, R đến hàng bằng với giá trị U1

phulien1902 · 29/9/20

hothanhlam.leok đã viết:
khi U1>U2 thì filldown cột P, Q, R đến hàng bằng với giá trị U1

Vậy có nghĩa là các giá trị trongcột P,Q,R lúc này sẽ được thay bằng giá trị U1?

hothanhlam.leok · 29/9/20

phulien1902 đã viết:
Vậy có nghĩa là các giá trị trongcột P,Q,R lúc này sẽ được thay bằng giá trị U1?

ko phải anh ơi, ví dụ giá trị U1 LÀ 3000, U2 LÀ 2197
thì công thức P1 là =[DATABASE.xlsm]SWATCH!A1
P2 là =[DATABASE.xlsm]SWATCH!A2
....
P3000 = =[DATABASE.xlsm]SWATCH!A3000
tương tự với cột Q và R

Xin giúp code VBA tự động kéo công thức

Thành viên thường trực

File đính kèm

linhvtm84@gmail.com

Thành viên thường trực

Thành viên gạo cội

linhvtm84@gmail.com

Thành viên thường trực

Cạo Rồi Khỏi Gội

Thành viên mới

linhvtm84@gmail.com

Thành viên mới

Thành viên gạo cội

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên mới

File đính kèm

GPE - My love

Thành viên mới

GPE - My love

Thành viên mới