mrfeed87
Thành viên mới

- Tham gia
- 5/11/21
- Bài viết
- 33
- Được thích
- 17
- Giới tính
- Nam
Private Sub Worksheet_Change(ByVal Target As Range)Hi bạn, mình test thứ có chạy, mà giờ mình cần ở vị trí khác, ví dụ từ AA đến AF thì phải sửa ntn bạn, mình mò mà ko biết nhiều nên ko sửa được
'KHAI BAO BIEN
Dim firtsCol As String, lastCol As String 'Khai báo biên cột đầu và cột cuối theo dạng chữ
Dim fc As Long, lc As Long 'Khai báo biên cột đầu và cột cuối theo dạng số
Dim lr As Long 'Khai báo biến dòng cuối
Dim r As Range, activeRange As Range 'Khai báo biến vùng được chọn để thực hiện
'GAN GIA TRI CAC BIEN
firtsCol = "AA" 'Chọn cột đầu (Theo dạng chữ)
lastCol = "AE" 'Chọn cột cuối (Theo dạng chữ)
fc = Columns(firtsCol).Column 'Lấy giá trị cột đầu
lc = Columns(lastCol).Column 'Lấy giá trị cột cuối
lr = Cells(Rows.Count, fc).End(xlUp).Row 'lay gia tri dong duoc chon
'THUC HIEN
If Not Intersect(Target, Range(Cells(1, fc), Cells(lr, lc))) Is Nothing Then
Set activeRange = Range(Cells(lr, fc), Cells(lr, lc - 1))
For Each r In activeRange
If r <> "" Then r.Offset(0, 1).Select
Next
If Cells(lr, lc) <> "" Then
Cells(lr, lc).Offset(1, fc - lc).Select
End If
End If
End Sub
Bài đã được tự động gộp:
Bạn thay cột muốn chọn vào chỗ bôi đậm của đoạn codePrivate Sub Worksheet_Change(ByVal Target As Range)
'KHAI BAO BIEN
Dim firtsCol As String, lastCol As String 'Khai báo biên cột đầu và cột cuối theo dạng chữ
Dim fc As Long, lc As Long 'Khai báo biên cột đầu và cột cuối theo dạng số
Dim lr As Long 'Khai báo biến dòng cuối
Dim r As Range, activeRange As Range 'Khai báo biến vùng được chọn để thực hiện
'GAN GIA TRI CAC BIEN
firtsCol = "AA" 'Chọn cột đầu (Theo dạng chữ)
lastCol = "AE" 'Chọn cột cuối (Theo dạng chữ)
fc = Columns(firtsCol).Column 'Lấy giá trị cột đầu
lc = Columns(lastCol).Column 'Lấy giá trị cột cuối
lr = Cells(Rows.Count, fc).End(xlUp).Row 'lay gia tri dong duoc chon
'THUC HIEN
If Not Intersect(Target, Range(Cells(1, fc), Cells(lr, lc))) Is Nothing Then
Set activeRange = Range(Cells(lr, fc), Cells(lr, lc - 1))
For Each r In activeRange
If r <> "" Then r.Offset(0, 1).Select
Next
If Cells(lr, lc) <> "" Then
Cells(lr, lc).Offset(1, fc - lc).Select
End If
End If
End Sub