Nhờ giúp về vấn đề sửa dữ liệu từ ngang thành dọc. (1 người xem)

[khamha]

Như tiêu đề...mình đã có một File có thể sửa dữ liệu trong Sheet"DATA" từ Sheet"Replace" .Nhưng là sửa theo chiều ngang.
Các bạn giúp mình sửa lại để cho nó sửa theo chiều dọc "Tức là dữ liệu cần sửa trong Sheet"DATA" sẽ hiện tại Sheet"Replace2" theo chiều dọc ,Khi ta sửa xong & Save thì nó sẽ Save theo chiều ngang" Các bạn xem File đính kèm & giúp mình nhé...Thank

 

[nghiaphuc]

Như tiêu đề...mình đã có một File có thể sửa dữ liệu trong Sheet"DATA" từ Sheet"Replace" .Nhưng là sửa theo chiều ngang.
Các bạn giúp mình sửa lại để cho nó sửa theo chiều dọc "Tức là dữ liệu cần sửa trong Sheet"DATA" sẽ hiện tại Sheet"Replace2" theo chiều dọc ,Khi ta sửa xong & Save thì nó sẽ Save theo chiều ngang" Các bạn xem File đính kèm & giúp mình nhé...Thank

1. Code cho sheet Replace2 (để lấy thông tin ra mỗi khi chọn giá trị tại ô B1):
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Or Target.Count > 1 Then Exit Sub
[B3:B65] = WorksheetFunction.Transpose(Sheets("DATA").[A2:BK2].Offset([B1]))
End Sub[/GPECODE]
2. Code để lưu thông tin (đặt trong Module):
[GPECODE=vb]Sub SaveInfo()
Sheets("DATA").[A2:BK2].Offset([B1]) = WorksheetFunction.Transpose([B3:B65])
End Sub[/GPECODE]

 

[khamha]

1. Code cho sheet Replace2 (để lấy thông tin ra mỗi khi chọn giá trị tại ô B1):
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Or Target.Count > 1 Then Exit Sub
[B3:B65] = WorksheetFunction.Transpose(Sheets("DATA").[A2:BK2].Offset([B1]))
End Sub[/GPECODE]
2. Code để lưu thông tin (đặt trong Module):
[GPECODE=vb]Sub SaveInfo()
Sheets("DATA").[A2:BK2].Offset([B1]) = WorksheetFunction.Transpose([B3:B65])
End Sub[/GPECODE]

Bạn nghiaphuc thêm cho đoạn Code "Báo lỗi" Khi bấm Save mà để trống dữ liệu luôn nhé...Thank

 

[nghiaphuc]

Bạn nghiaphuc thêm cho đoạn Code "Báo lỗi" Khi bấm Save mà để trống dữ liệu luôn nhé...Thank

Ý của anh là nếu vùng B3:B65 mà trống trơn thì không được lưu dữ liệu phải không? Nếu đúng vậy thì anh thêm đoạn này vào đầu sub SaveInfo:
[GPECODE=vb]If WorksheetFunction.CountA([B3:B65]) = 0 Then
MsgBox "Gi gi do"
Exit Sub
End If[/GPECODE]

 

[khamha]

Sao mình chèn Code này

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$B$66" Then
Call SaveInfo
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$B$1" Or Target.Count > 1 Then Exit Sub
    [B3:B65] = WorksheetFunction.Transpose(Sheets("DATA").[A2:BK2].Offset([B1]))
End Sub
Sub SaveInfo()
If WorksheetFunction.CountA([B3:B65]) = 0 Then
    MsgBox "Gi gi do"
    Exit Sub
End If
    Sheets("DATA").[A2:BK2].Offset([B1]) = WorksheetFunction.Transpose([B3:B65])
End Sub

vào thì phần bẫy lỗi ko hoạt động...bạn "nghiaphuc" xem lại giúp mình nhé...Thank