Cần sửa vòng lặp đơn giản này. (1 người xem)

[win4u]

Trình VBA của em là con số 0 tròn trịa. Bác nào sửa giúp em vòng lặp sau với:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i
        i = 0
    Do While Cells(Target.Row + i, 1) <> 0
        If Cells(Target.Row + i, 1) <> 0 Then Cells(Target.Row + i, 1).Copy
            If Cells(Target.Row + i + 1, 1) = "" Then Cells(Target.Row + i + 1, 1).Paste
        i = i + 1
            End If
        End If
    Loop
End Sub

 

[chibi]

Bạn có thể mô tả mục tiêu công việc trên của bạn được không?

 

[win4u]

Trên cột A chứa thông tin ngày tháng. Mình cần viết macro để tìm ngày trên cột này và copy vào các ô còn trống phía dưới, đ/k phục thuộc vào cột K, khi K kéo đến đâu thì cột A/ngày/ tự động điền ngày vào theo ngày ở dòng bên trên.

 

[ndu96081631]

Vậy thì sửa như vầy đi:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, Er As Long
  If Not Intersect(Range("K3:K1000"), Target) Is Nothing Then
    Er = Range("K1000").End(xlUp).Row
    For i = 3 To Er
      If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
    Next
  End If
End Sub

 

[win4u]

Nếu em muốn dùng code trên cho nhiều sheet thì phải làm sao ạ ? copy code vào mỗi sheet ?

Nêu điều kiện kg giới hạn ở K1000 mà là K<>0 thì khi chạy code sẽ nặng hơn ?

 

[ThuNghi]

Nếu em muốn dùng code trên cho nhiều sheet thì phải làm sao ạ ? copy code vào mỗi sheet ?

Nêu điều kiện kg giới hạn ở K1000 mà là K<>0 thì khi chạy code sẽ nặng hơn ?

k <65537 do Ex2003 có 65536 row thôi.
Có 2 cách:
- Chép code vào từng sh
- Chép vào Module, tạo 1 phím tắc hay Icon thi hành lệnh
if K<> "" thì thực thi lệnh điền vào A đại lọai như, Ctr t

 [quote]Sub UpDate()

' Keyboard Shortcut: Ctrl+t
'
 Dim i As Integer, Er As Integer
    Er = Range("K65536").End(xlUp).Row
    For i = 3 To Er
        If Cells(i, 11) <> "" Then
            If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
        End If
    Next
End Sub
[/quote]

 

[win4u]

Cám ơn các bác nhìu nhìu, nếu em muốn duyệt thêm cột nữa, cách duyệt như sau:
nếu H3<>"" thì thực hiện đoạn code trên theo cột H
nếu N3<>"" thì thực đoạn code trên theo cột N


Với 11 nghìn dòng, em chờ mệt mỏi luôn.

 

[XuanThanh]

Muốn duyệt theo cột H khi H3<>"" Thì thay câu

If Cells(i, 11) <> "" Then
   If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
End If

bằng câu

If Cells(3, 8) <> "" Then
   If Cells(i, 8) = "" Then Cells(i, 8) = Cells(i - 1, 8)
End If

Tương tự cho cột N thì thay số 8 bằng số 14

 

[win4u]

Em định viết như thế này nhưng nó kg chạy hoặc chỉ chạy theo điều kiện của ELSE.
Có cách nào để trước khi chạy nó hỏi xem mình cần cột nào vào chạy theo điều kiện của cột ấy kg ạ ?

Ở câu lệnh

If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)

hình như nó kg copy công thức mà chỉ copy data dạng text thì phải.

Đây là đoạn code của em định viết nhưng kg thành công :

Sub UpDate()
 Dim i As Integer, Er As Integer
    If H5 <> "" Then
        Er = Range("H65536").End(xlUp).Row
        For i = 4 To Er
            If Cells(i, 8) <> "" Then
                If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
            End If
        Next
    Else
        Er = Range("N65536").End(xlUp).Row
        For i = 4 To Er
            If Cells(i, 14) <> "" Then
                If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
            End If
        Next
    End If
End Sub

 

[XuanThanh]

1/ Xem lại : bạn đặt điều kiện H5<>"" mà vòng lặp lại bắt đầu duyệt từ 4 là sao?
2/ Nếu dùng Else trong trường hợp này thì không đúng vì nếu H5="" thì khi tất cả các ô còn lại <>"", Code sẽ thực thi

 

[ThuNghi]

Đây là đoạn code của em định viết nhưng kg thành công :

Sub UpDate()
 Dim i As Integer, Er As Integer
    [COLOR=Red]If [B]H5[/B] <> "" Then[/COLOR]
        Er = Range("H65536").End(xlUp).Row
        For i = 4 To Er
            If Cells(i, 8) <> "" Then
                If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
            End If
        Next
    Else
        Er = Range("N65536").End(xlUp).Row
        For i = 4 To Er
            If Cells(i, 14) <> "" Then
                If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)
            End If
        Next
    End If
End Sub

Xin thay
If H5 <> "" Then
là
if [H5] <> "" then
Và chạy lại
Cám ơn thì nhấn nút "Thank" nhé!

 

[win4u]

Cám ơn bác đã chạy như robot.

 

[voda]

Bạn dùng thử đoạn code sau:

Sub UpDate()
 Dim i As Integer, j As Integer, Er As Integer
  j = ActiveCell.Column
  Er = Cells(65000, j).End(xlUp).Row
  For i = 1 To Er
    If Cells(i, ActiveCell.Column) <> "" And Cells(i, 1) = "" Then
       Cells(i, 1) = Cells(i - 1, 1)
    End If
  Next
End Sub

Muốn duyệt điều kiện ở cột nào, bấm chọn 1 ô bất kỳ trong cột đó trước khi chạy thủ tục.

 

[win4u]

Các bác giúp em, ở câu lệnh:

If Cells(i, 1) = "" Then Cells(i, 1) = Cells(i - 1, 1)

hình như nó kg copy công thức mà chỉ copy data dạng text thì phải.


Nếu muốn copy công thức của dòng bên trên thì phải làm sao ạ ????

 

[voda]

Có 2 trường hợp:
1. Copy công thức với địa chỉ tuyệt đối, dùng code sau

If Cells(i, ActiveCell.Column) <> "" And Cells(i, 1) = "" Then
       Cells(i, 1) = Cells(i - 1, 1). formula
    End If

2. Copy công thức với địa chỉ tương đối, dùng code sau

  For i = 1 To Er
      If Cells(i, ActiveCell.Column) <> "" And Cells(i, 1) = "" Then
            Cells(i - 1, 1).Copy
            ActiveSheet.Paste Destination:=Cells(i, 1)
      End If
  Next
Application.CutCopyMode = False

 

[win4u]

Cuối cùng em ra nó như thế này, các bác có chỉnh sửa gì nữa kg ạ

Sub UpDate2()
 Dim i As Integer, j As Integer, Er As Integer

 
  j = ActiveCell.Column
  Er = Cells(65000, j).End(xlUp).Row
  For i = 1 To Er
    If Cells(i, ActiveCell.Column) <> "" And Cells(i, 1) = "" Then
       Cells(i, 1) = Cells(i - 1, 1).Formula
    End If
  Next
  
 Columns("A:A").Select
 Selection.NumberFormat = "dd/mm/yy;@"
 [A65536].End(xlUp).Select
End Sub

 

[XuanThanh]

1/ Bạn định dạng cột A theo dang ngày tháng năm rồi bỏ hàng

Columns("A:A").Select
 Selection.NumberFormat = "dd/mm/yy;@"
 [A65536].End(xlUp).Select

2/ Nếu muốn sử dụng thì

Cells(i,1).NumberFormat="dd/mm/yy"