Viết dùm em code cập nhật dữ liệu

Liên hệ QC
tuyettrang186

tuyettrang186

Thành viên mới
Tham gia
11/12/10
Bài viết
30
Được thích
4
Em có ví dụ này nhờ các huynh viết dùm em code cập nhật dữ liệu sang Sheet bên cạnh (Cập nhật dữ liệu từ Sheet1 sang Sheet2) nhé!
 

File đính kèm

  • GPEbt.rar
    4.9 KB · Đọc: 27
Sắp xếp theo thời gian sắp xếp theo bầu chọn
tuyettrang186 đã viết:
Em có ví dụ này nhờ các huynh viết dùm em code cập nhật dữ liệu sang Sheet bên cạnh (Cập nhật dữ liệu từ Sheet1 sang Sheet2) nhé!
Nhấp chuột vào đây để mở rộng...
Sau khi bạn nhập đơn giá xong, code sẽ nhập số liệu sang sheet2
Trường hợp khi bạn nhập sai đơn giá thì nhập lại nó sẽ xuất hàng khác đấy, vấn đề này bạn tự khắc phục thêm nhé
 

File đính kèm

  • GPEbt.xls
    39.5 KB · Đọc: 32
Upvote 0
viehoai đã viết:
Sau khi bạn nhập đơn giá xong, code sẽ nhập số liệu sang sheet2
Trường hợp khi bạn nhập sai đơn giá thì nhập lại nó sẽ xuất hàng khác đấy, vấn đề này bạn tự khắc phục thêm nhé
Nhấp chuột vào đây để mở rộng...

Cám ơn viehoai nhiều! Nhưng ý em muốn là khi nhập liệu bất kỳ ở ô nào trong bảng (Sheet1) đó thì nó sẽ tự cập nhật sang sheet2. Theo em thì mình nên tạo một thủ tục và sau đó cho nó vào sự kiện Activate thì OK. Nhưng quả thực em vẫn chưa là được.
 
Upvote 0
Đây là code của em:
Với sub:
PHP: 
Sub cap_nhat()
    Dim i As Long
    i = Range("A65535").End(xlUp).Row
    S2.Range("A4:D65535").ClearContents
    With S2
        If Not Range("A" & i) Is Nothing Then
            .Range("A65500").End(xlUp).Offset(1, 1).Resize(, 2).Value = S1.Range([A7], [A65535].End(xlUp)).Offset(, 1).Resize(, 2).Value
            .Range("A65500").End(xlUp).Offset(1, 3).Value = S1.Range([A7], [A65535].End(xlUp)).Offset(, 5).Value
        End If
    End With
End Sub
với sheet1 dùng sự kiện Activate:
PHP: 
Private Sub Worksheet_Activate()
    cap_nhat
End Sub
Tuy nhiên còn cột STT của Sheet2 thì vẫn chưa làm được.
Em nhờ mọi người xem và sửa thêm dùm em nhé!
 

File đính kèm

  • GPEbt_sua.rar
    10.9 KB · Đọc: 22
Upvote 0
Mọi người xem dùm em chút nhé!! Em đã sửa mà vẫn không được.
 
Upvote 0
Thử làm không biết có đúng ý bạn không. Thân.
 

File đính kèm

  • GPEbt_sua1.rar
    12.5 KB · Đọc: 33
Upvote 0
Ba Tê đã viết:
Xem thử bài này có được không nhé!
Nhấp chuột vào đây để mở rộng...

Ba Tê ơi, theo em dòng này nên sửa thế này cho gọn:
PHP: 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Thành:
PHP: 
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=False
Một lần nữa cám ơn anh Ba Tê rất nhiều!
 
Upvote 0
Bác Ba Te ơi, Code của bác nên rút gọn lại như thế này thôi

Mã: 
Sub Worksheet_Activate()
Dim nN As Long
nN = WorksheetFunction.CountA(S1.[A7:A1000])
S2.[A4:D1000].ClearContents
S2.[B4].Resize(nN, 2).Value = S1.[B7].Resize(nN, 2).Value
S2.[D4].Resize(nN).Value = S1.[F7].Resize(nN).Value
S2.[A4].Resize(nN).FormulaR1C1 = "=MAX(R3C1:R[-1]C)+1"
S2.[A4].Resize(nN).Value = S2.[A4].Resize(nN).Value
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Trùng bài, nhờ Mode xoá giúp
 
Upvote 0
thivantan đã viết:
Thử làm không biết có đúng ý bạn không. Thân.
Nhấp chuột vào đây để mở rộng...

Code của bạn mình xin sửa như thế này nhé:
PHP: 
Private Sub Worksheet_Activate()
Dim i As Long, j As Long
Application.ScreenUpdating = False
i = S1.Range("A65000").End(xlUp).Row
j = Range("B65000").End(xlUp).Row
S2.Range("A4:D65535").ClearContents
If S1.Range("A" & i) > 6 Then
    With S2
    S1.Range("B7:C" & i).Copy: .[B4].PasteSpecial 3
    S1.Range("F7:F" & i).Copy: .[D4].PasteSpecial 3
    .Range("A4:A" & j) = Evaluate("=row(R:R)")
    End With
    Application.CutCopyMode = False
    Range("D3").Select
End If
Application.ScreenUpdating = False
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
sealand đã viết:
Bác Ba Te ơi, Code của bác nên rút gọn lại như thế này thôi

Mã: 
Sub Worksheet_Activate()
Dim nN As Long
nN = WorksheetFunction.CountA(S1.[A7:A1000])
S2.[A4:D1000].ClearContents
S2.[B4].Resize(nN, 2).Value = S1.[B7].Resize(nN, 2).Value
S2.[D4].Resize(nN).Value = S1.[F7].Resize(nN).Value
S2.[A4].Resize(nN).FormulaR1C1 = "=MAX(R3C1:R[-1]C)+1"
S2.[A4].Resize(nN).Value = S2.[A4].Resize(nN).Value
End Sub
Nhấp chuột vào đây để mở rộng...
Đúng là rất gọn, Code của tôi chỉ là "Hậu quả" của Record New Macro... mà thôi, vì thế nó dài lòng thòng mà chưa đủ trình độ tinh chỉnh.
Cảm ơn Bạn vì tôi đã học hỏi được thêm những cách vận dụng mới.
 
Upvote 0
NH_DK đã viết:
Code của bạn mình xin sửa như thế này nhé:
PHP: 
Private Sub Worksheet_Activate()
Dim i As Long, j As Long
Application.ScreenUpdating = False
i = S1.Range("A65000").End(xlUp).Row
j = Range("B65000").End(xlUp).Row
S2.Range("A4:D65535").ClearContents
If S1.Range("A" & i) > 6 Then
    With S2
    S1.Range("B7:C" & i).Copy: .[B4].PasteSpecial 3
    S1.Range("F7:F" & i).Copy: .[D4].PasteSpecial 3
    .Range("A4:A" & j) = Evaluate("=row(R:R)")
    End With
    Application.CutCopyMode = False
    Range("D3").Select
End If
Application.ScreenUpdating = False
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn mà đặt biến j= Range("B65000").End(xlUp).Row trước khi copy số liệu sẽ bị sai đấy, không tin bạn thử lại xem nhé.
 
Upvote 0
NH_DK đã viết:
Code của bạn mình xin sửa như thế này nhé:
PHP: 
Private Sub Worksheet_Activate()
Dim i As Long, j As Long
Application.ScreenUpdating = False
i = S1.Range("A65000").End(xlUp).Row
j = Range("B65000").End(xlUp).Row
S2.Range("A4:D65535").ClearContents
If S1.Range("A" & i) > 6 Then
With S2
S1.Range("B7:C" & i).Copy: .[B4].PasteSpecial 3
S1.Range("F7:F" & i).Copy: .[D4].PasteSpecial 3
.Range("A4:A" & j) = Evaluate("=row(R:R)")
End With
Application.CutCopyMode = False
Range("D3").Select
End If
Application.ScreenUpdating = False
End Sub
Nhấp chuột vào đây để mở rộng...
1. Khi ở sheet2, chuyển sang hoạt động sheet 1 bạn sẽ bị chế độ "Application.CutCopyMode" -> rất khó chịu
2. Giả sử khi sheet1 có một hàng trống thì số thứ tự ??
 
Upvote 0
thivantan đã viết:
Bạn mà đặt biến j= Range("B65000").End(xlUp).Row trước khi copy số liệu sẽ bị sai đấy, không tin bạn thử lại xem nhé.
Nhấp chuột vào đây để mở rộng...

Mình test thấy có sai đâu? Bạn chỉ dùm mình cụ thể hơn? Còn anh viehoai nói đúng. nhưng em vẫn chưa biết khắc phục bằng cách nào được. Em đang tìm phương án.
 
Upvote 0
NH_DK đã viết:
Mình test thấy có sai đâu? Bạn chỉ dùm mình cụ thể hơn? Còn anh viehoai nói đúng. nhưng em vẫn chưa biết khắc phục bằng cách nào được. Em đang tìm phương án.
Nhấp chuột vào đây để mở rộng...
Theo tôi nếu bạn đặt biến j thì nên đặt sau dòng
PHP: 
S1.Range("F7:F" & i).Copy: .[D4].PasteSpecial 3
j = Range("B65000").End(xlUp).Row
.Range("A4:A" & j) = Evaluate("=row(R:R)")
...

 
Upvote 0
thivantan đã viết:
Bạn thử xoá hết dữ liệu bên s2 trừ hàng tiêu đề và di chuyển sang s1 sau đó quay lại s2, bạn thử xem nhé.
Nhấp chuột vào đây để mở rộng...

Mình đã làm thử như yêu cầu của bạn nhưng chẳng sao cả. Thôi việc lỗi hay không lỗi mình không quan trọng nhưng mình thắc mắc bạn nói vấn đề code
PHP: 
Private Sub Worksheet_Activate()
Dim i As Long, j As Long
Application.ScreenUpdating = False
i = S1.Range("A65000").End(xlUp).Row
j = Range("B65000").End(xlUp).Row   'Bạn muốn chuyển hàng này
S2.Range("A4:D65535").ClearContents
If S1.Range("A" & i) > 6 Then
With S2
S1.Range("B7:C" & i).Copy: .[B4].PasteSpecial 3
S1.Range("F7:F" & i).Copy: .[D4].PasteSpecial 3
 
'Xuống ở đây

.Range("A4:A" & j) = Evaluate("=row(R:R)")
End With
Application.CutCopyMode = False
Range("D3").Select
End If
Application.ScreenUpdating = False
End Sub
Khác nhau ở chỗ nào? Trong lúc theo như code mình không thấy có gì khác (vì 5 câu lệnh ở giữa không phụ thuộc gì vào j cả??
 
Upvote 0
sealand đã viết:
Bác Ba Te ơi, Code của bác nên rút gọn lại như thế này thôi

Mã: 
Sub Worksheet_Activate()
Dim nN As Long
nN = WorksheetFunction.CountA(S1.[A7:A1000])
S2.[A4:D1000].ClearContents
S2.[B4].Resize(nN, 2).Value = S1.[B7].Resize(nN, 2).Value
S2.[D4].Resize(nN).Value = S1.[F7].Resize(nN).Value
S2.[A4].Resize(nN).FormulaR1C1 = "=MAX(R3C1:R[-1]C)+1"
S2.[A4].Resize(nN).Value = S2.[A4].Resize(nN).Value
End Sub
Nhấp chuột vào đây để mở rộng...

Anh sealand ơi, nếu bên Sheet1 mà dữ liệu có dòng trống thì cập nhật sang bên sheet2 lại bị lỗi. Anh xem lại dùm em nhé!
(File đính kèm)
 

File đính kèm

  • GPEbt_sua.rar
    7.5 KB · Đọc: 14
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

C
Xin công thức xếp loại có điều kiện.
Trả lời
2
Đọc
71
VetMini
V
8
  • Question
Xin giúp: Nhóm (group data) các dòng trong bảng tính
Trả lời
12
Đọc
464
ptm0412
ptm0412
hongquan93vn
Tìm công thức có thể đánh STT của giá trị mỗi lần xuất hiện
2
Trả lời
28
Đọc
569
ptm0412
ptm0412
T
  • Đã khóa
Tìm một bạn có kinh nghiệm về Excel
    • Cười
Trả lời
0
Đọc
80
tinhnhi1202
T
H
  • Question
Code VBA cộng tổng trên bảng CĐKT
Trả lời
4
Đọc
140
vak1590
vak1590
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom