xin giúp đỡ viết 1 macro để copy (1 người xem)

[boma]

Các bạn có thể giúp mình viết 1 lệnh dùng để copy theo yêu cầu như sau :


-giả sử mình có 2 cột dữ liệu A, B. Giữ liệu được nhập mỗi ngày từ trên suống dưới. Cột A là ngày tháng, cột B là dữ liệu dạng số, dấu "-" là các cell rỗng, giữ liệu được nhập bắt đầu từ cell A1, B1

.........A................B
16/12/2006 .........1
16/12/2006 .........-
16/12/2006 .........-
16/12/2006 .........2
16/12/2006 .........-
16/12/2006 .........-
-
-


​

-khi mình chọn cell B1 (có giá trị là 1 như ví dụ) thực hiện lệnh thì nó tự động copy giá trị 1 suống các cell rỗng phía dưới, khi gặp giá trị khác rỗng (giá trị 2 như ví dụ) thì nó sẽ copy giá trị 2 suống dứơi tương tự như khi làm với giá trị 1. Cứ tiếp tục như vậy cho đến khi bên cột A là giá trị rỗng thì ngừng lệnh. (trong bảng tính của mình có nhiều cột nên lệnh này viết sao cho có thể thực hiện được ở bất kỳ cột nào và bất kỳ vị trí nào mà mình chọn)

-Mình không biết nhiều về VBA lắm nên nghĩ hoài không ra, hi vọng mọi người xẽ giúp mình. Xin cảm ơn

 

[Song Huong]

Các bạn có thể giúp mình viết 1 lệnh dùng để copy theo yêu cầu như sau :





-giả sử mình có 2 cột dữ liệu A, B. Giữ liệu được nhập mỗi ngày từ trên suống dưới. Cột A là ngày tháng, cột B là dữ liệu dạng số, dấu "-" là các cell rỗng, giữ liệu được nhập bắt đầu từ cell A1, B1

.........A................B
16/12/2006 .........1
16/12/2006 .........-
16/12/2006 .........-
16/12/2006 .........2
16/12/2006 .........-
16/12/2006 .........-
-
-





​

-khi mình chọn cell B1 (có giá trị là 1 như ví dụ) thực hiện lệnh thì nó tự động copy giá trị 1 suống các cell rỗng phía dưới, khi gặp giá trị khác rỗng (giá trị 2 như ví dụ) thì nó sẽ copy giá trị 2 suống dứơi tương tự như khi làm với giá trị 1. Cứ tiếp tục như vậy cho đến khi bên cột A là giá trị rỗng thì ngừng lệnh. (trong bảng tính của mình có nhiều cột nên lệnh này viết sao cho có thể thực hiện được ở bất kỳ cột nào và bất kỳ vị trí nào mà mình chọn)

-Mình không biết nhiều về VBA lắm nên nghĩ hoài không ra, hi vọng mọi người xẽ giúp mình. Xin cảm ơn

Chào bạn!
Gửi bạn thủ tục copy theo bạn yêu cầu.
- Bạn chọn khối dữ liệu cột cần copy.
- Run CopyNextRow

Sub CopyNextRow()

' Khai bao cac bien
Dim ColSelect, BegRow, EndRow, CurValue, ColValue, Counter, NextRow, i, j

' Xac dinh cot, dong can copy.
Counter = 0
For Each Item In Selection
If Counter = 0 Then
BegRow = Item.Row
ColSelect = Item.Column
Counter = Counter + 1
End If

EndRow = Item.Row

Next Item


' So sanh gia tri, copy cho dong ke tiep
For i = BegRow To EndRow

CurValue = Cells(i, ColSelect).Value

NextRow = i + 1

For j = NextRow To EndRow
ColValue = Cells(j, ColSelect).Value

If ColValue = 0 Or RTrim(ColValue) = "" Then
Cells(j, ColSelect) = CurValue
Else
Exit For
End If

Next j

Next i

End Sub

Thân

 

[SA_DQ]

Thêm 1 macro nữa để bạn tham khảo:

Các bạn có thể giúp mình viết 1 lệnh dùng để copy theo yêu cầu như sau : . . .
(trong bảng tính của mình có nhiều cột nên lệnh này viết sao cho có thể thực hiện được ở bất kỳ cột nào và bất kỳ vị trí nào mà mình chọn)

Option Explicit:            Dim iZ As Integer
[b]Sub CopyDown()[/b]
1 Dim Temp, StrC As String
2 With Selection
3     StrC = .Address:               iZ = .Row:            If .Value = "" Then Exit Sub
4 End With
5 Do
6    iZ = 1 + iZ:                            StrC = Left(StrC, 3) & CStr(iZ)
7    Range(StrC).Select
8    With Selection
9        If Not IsDate(.Offset(0, -1).Value) Then Exit Do
10        If .Value <> "" Then
11            Temp = .Value
12        ElseIf .Value = "" Then
13            .Value = Temp
14        End If
15    End With
16 Loop
[b]End Sub[/b]

Yêu cầu cột trái kề nó là dữ liệu kiểu Ngày; & phải kích hoạt ô có dữ liệu (<> "")

 

[boma]

Cảm ơn mọi người đã quan tâm, mình đã thử đoạn mã của bạn Song Huong rồi, hay lắm, tuy chưa đúng điều kiện đặt ra ( chỉ chọn 1 cell từ điểm bắt đầu, tự động kết thúc lệnh dựa vào cột ngày tháng) nhưng cũng đã giúp mình giải quyết công việc đang gặp.
-lam như Song Huong có 1 số điểm ko thuận tiện như cứ mỗi cột cần copy mình phải chọn vùng cần copy và phải định vị chính xác vị trí dòng cuối cùng, nếu nhiều cột và mỗi cột gồm nhiều hàng thì công việc xẽ lập đi lập lại nhiều lần có thể làm giảm độ chính xác nếu định vị sai dòng cuối hoặc vùng chọn bị sai mà mình ko biết
-vì vậy mình mới đề ghị dùng cột ngày tháng làm chuẩn cho tất cả và ở mỗi cột chỉ cần chọn cell đầu tiên
-mình xẽ thử đoạn mã của SA_QD, giá mà mọi người giải thích luôn các hàm dùng trong các dòng lệnh luôn thì hay quá, để nhiều người chưa rành như mình có thể tự học luôn. Thanks mọi người

 

[SA_DQ]

Dịch từ VBA sang VNi!

Cảm ơn mọi người đã quan tâm. . . . . giá mà mọi người giải thích luôn các hàm dùng trong các dòng lệnh luôn thì hay quá, để nhiều người chưa rành như mình có thể tự học luôn. Thanks mọi người

(ó hàm nào đâu; đó toàn là ~ dòng lệnh thôi;
(/ậy, nhưng mình vẫn diễn dịch cho bạn đây (Đọc từ phải qua trái là tật của mình):
C1: Khai báo 2 biến StrC & Temp
C2-4: (Trước khi cho Macro chạy, ta phải chọn 1 ô có DL (dữ liệu)); Các câu lệnh này làm việc với ô đã chọn, gồm 3 câu lệnh trong C3
1. Đem địa chỉ gán vô biến StrC
2. Đem dòng hiện hành gán vô biến iZ
3. Thoát khỏi CTr khi ô này không chứa giá trị
C5-C16: Tạo vòng lặp duyệt cột dữ liệu
C6.1: Biến iZ được tăng 1 đơn vị;
C6.2: Chuyển biến iZ thành dạng chuỗi & nối vô biến StrC => địa chỉ ô dưới kế tiếp;
C7: Ô dưới kế tiếp được chọn;
C8-15: Xử lí ô được chọn này;
C9: Thoát nếu ô trái kề bên không chứa DL dạng ngày
C10: Nếu 'trống' không phải là giá trị của ô hiện hành
C11: DL ô này đem gán vô biến Temp
C12: Nếu 'Trống' đúng là giá trị ô này đang chứa, thì;
C13: Giá trị trong biến Temp đem gán cho ô hiện hành này;
. . . .
Bổ sung đoạn code để bạn tự dịch & dùng (trong trường hợp nhiều ô trống liên tục trong cột khảo sát)

Dim iZ As Integer
 [b] Sub Copy_Down()[/b]
On Error GoTo Loi_CDown
Dim Temp, StrC As String:               Dim UniRange As Range
StrC = Selection.Address:               iZ = Selection.Row
If Selection.Value = "" Then Exit Sub Else Temp = Selection.Value
 Do
    iZ = 1 + iZ:                            StrC = Left(StrC, 3) & CStr(iZ)
    Range(StrC).Select
    With Selection
100        If Not IsDate(.Offset(0, -1).Value) Then Exit Do
102        If .Value <> "" Then
103            If Not UniRange Is Nothing Then
104                UniRange.Value = Temp
105                Set UniRange = Nothing
106            Else
107                Temp = .Value
108            End If               [color="blue"]         '  Temp = .Value[/color]
109        ElseIf .Value = "" Then
110            If UniRange Is Nothing Then
111                Set UniRange = Selection
112            Else
113                Set UniRange = Application.Union(UniRange, Selection)
114            End If                  [color="blue"]      '  .Value = Temp[/color]
115        End If
    End With
 Loop
Err_CDown:              Exit Sub
Loi_CDown:
    Select Case Err
    Case 91
        Resume Next
    Case Else
        MsgBox Error, , Str(Err) & "  " & Str(Erl)
    End Select
    Resume Err_CDown
[b]End Sub [/b]

Ghi chú: Ở đây câu

Union(UniRange, Selection)

cũng không phải là một hàm, mà là phương thức (method)

 

[boma]

Option Explicit:            Dim iZ As Integer
[b]Sub CopyDown()[/b]
1 Dim Temp, StrC As String
2 With Selection
3     StrC = .Address:               iZ = .Row:            If .Value = "" Then Exit Sub
4 End With
5 Do
6    iZ = 1 + iZ:                            StrC = Left(StrC, 3) & CStr(iZ)
7    Range(StrC).Select
8    With Selection
9        If Not IsDate(.Offset(0, -1).Value) Then Exit Do
10        If .Value <> "" Then
11            Temp = .Value
12        ElseIf .Value = "" Then
13            .Value = Temp
14        End If
15    End With
16 Loop
[b]End Sub[/b]

Yêu cầu cột trái kề nó là dữ liệu kiểu Ngày; & phải kích hoạt ô có dữ liệu (<> "")

SA QD à, code đầu tiên của bạn mình thử rồi, tiện hơn nhiều đó nhưng mà sao giá trị đầu tiên nó không thực hiện việc copy mà để đến giá trị thứ 2 nó mới thực hiện
Nếu cột ngày tháng không liền kề với nó thì sao nhỉ ?

 

[boma]

/(hông rõ í bạn lắm?! Bạn xem lại chỗ iZ= .Row & câu iZ = 1+ iZ ý![/quote]

- là vầy nè
1
-
-
2
-
3
-

nó chỉ copy từ 2 trở suống thôi mặc dù mình chọn 1

 

[SA_DQ]

Bạn thử chạy đoạn code thứ hai trong trường hợp này xem thử; Thực ra nó rườm rà nhưng mình đoán sẽ nhanh hơn nữa; & nếu có sai sót cho biết luôn, nha!
À mình xin lỗi vì sai tại dòng lệnh 3 chưa gán giá trị ô hiện tại vô biến Temp;
Bạn sửa lại như vầy giúp nha!

3                    iZ = .Row:             StrC = .Address
           Temp = .Value:       If Temp = "" Then Exit Sub

 

[boma]

-mấy bữa nay bận kiểm kê ở công ty nên ko online được, sorry nhiều nha
-SA_QD à, code đầu tiên của bạn mình đã sửa lại dòng 3 rồi chạy rất tốt
-còn code thứ 2 của bạn mình thử rồi nó bị ngược lại với code 1, copy từ trên suống dưới nhưng giá trị cuối cùng thì ko chịu copy
-"Nếu cột ngày tháng không liền kề với nó thì sao nhỉ ?", bạn chỉ mình cách "Xử lý điều này tại dòng lệnh số 9: .Offset(0,-1) => .Ofset(0,x)" của code 1, nhưng nếu trong cùng 1 bảng tính có nhiều cột phải sử lý thì mình phải vào VB sủa lại dòng mã cho mỗi cột sao, mong bạn góp thêm ý kiến. Thanks

 

[SA_DQ]

Sửa dòng lệnh số 9:

Trong excel bạn không thể không dùng hàm =OFFSET(iRow, iCol), phải không nào?
Trong VBA cũng tương tự thôi:
* Nếu cột ghi Ngày bên trái liền kề ta ghi Offset(0 , -1)
* Nếu trái cách 3 cột thì ghi : Offset(0, -4)
* Nếu bên phải liền kề - Offset(0, 1)
* Nếu cách 1 cột: Offset(0, 2)

Trường hợp tổng quát hơn: Nếu có nhiều cột cần chép thì:
khai báo 1 biến (VD : iCot) & dùng lệnh:
iCot = InputBox("HAY NHAP CHUAN: ")
& thay vô phương thức Offset(0, iCot)


(húc /(/)ừng /(/ăm /)/(ới!