Option Explicit
Const lRow As Long = 99
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Sh As Worksheet, Rw As Long, Col As Byte
If Not Intersect(Target, Range("B4:K" & lRow)) Is Nothing Then
Set Sh = ThisWorkbook.Worksheets("Nguon")
Rw = Target.Row: Col = Target.Column
With Sh.Cells(2 * (Rw - 2), Col)
Target.Value = .Value & Chr(10) + .Offset(1).Value
End With
End If
End Sub
Xài thử code nàyNhờ các bạn viết giúp đoạn CODE cho file gộp dữ liệu của 2 Cell sheet nguon vào 1 cell sheet dich, như file đính kèm
Xin cám ơn
Sub gop()
Dim data(), kq(), i, j, k
With Sheets("nguon")
data = .Range(.[B4], .[I65536].End(3)).Value
End With
ReDim kq(1 To UBound(data) / 2, 1 To 9)
For i = 1 To UBound(data) Step 2
k = k + 1
kq(k, 1) = k
For j = 2 To 9
kq(k, j) = data(i, j - 1) & vbLf & data(i + 1, j - 1)
Next
Next
Sheets("dich").[A4].Resize(k, 9) = kq
End Sub
Sub Ghep()
Dim Nguon As Variant, dich(), i, j, k As Long
Nguon = [b4:I53].Value
ReDim dich(1 To UBound(Nguon), 1 To 8)
For i = 1 To UBound(Nguon) Step 2
k = k + 1
For j = 1 To UBound(Nguon, 2)
dich(k, j) = Nguon(i, j) & Chr(10) & Nguon(i + 1, j)
Next j
Next i
Sheet3.[b4].Resize(k, j - 1).Value = dich
End Sub
Xài thử code này
PHP:Sub gop() Dim data(), kq(), i, j, k With Sheets("nguon") data = .Range(.[B4], .[I65536].End(3)).Value End With ReDim kq(1 To UBound(data) / 2, 1 To 9) For i = 1 To UBound(data) Step 2 k = k + 1 kq(k, 1) = k For j = 2 To 9 kq(k, j) = data(i, j - 1) & vbLf & data(i + 1, j - 1) Next Next Sheets("dich").[A4].Resize(k, 9) = kq End Sub
Ý bạn muốn tạo nút "Gộp dữ liệu" màu đỏ trong file bài #7 ah?Cho mình hỏi thêm; trong OFFICE 2010 làm thế nào để tạo nhãn như trong file để gán CODE chỉ giúp với
Hỏi ai thì bạn trích dẫn bài của người đó.Mình dung OFFiCE 2010 khi vào EXCEL không tìm thấy View\Toolbors\Foms hay View\Toolbors\Control Toolbox
để gán CODE cho nó, bạn chỉ giúp mình với