cách chuyển đổi vị trí và cách thêm khoảng trống

[boycodon2405]

chào mọi người
em có 2 trưởng hợp tương ứng với các ví dụ muốn nhờ ace giúp đỡ:
VD1: em muốn chuyển vị trí các ô từ hàng ngang sang dọc hoặc ngược lại
VD2: dưới mỗi dữ liệu sẽ insert cột hoặc dòng theo số lượng tùy chọn

 

[congnt92]

chào mọi người
em có 2 trưởng hợp tương ứng với các ví dụ muốn nhờ ace giúp đỡ:
VD1: em muốn chuyển vị trí các ô từ hàng ngang sang dọc hoặc ngược lại
VD2: dưới mỗi dữ liệu sẽ insert cột hoặc dòng theo số lượng tùy chọn

Gửi bạn tham khảo
Riêng ví dụ 1, hàm mình sử dụng đang giả sử số lượng phần tử của 2 cột là bằng nhau (trong ví dụ đều là 3 phần tử). Nếu số lượng lệch nhau sẽ cần hàm phức tạp hơn hoặc thậm chí VBA

 

[phulien1902]

chào mọi người
em có 2 trưởng hợp tương ứng với các ví dụ muốn nhờ ace giúp đỡ:
VD1: em muốn chuyển vị trí các ô từ hàng ngang sang dọc hoặc ngược lại
VD2: dưới mỗi dữ liệu sẽ insert cột hoặc dòng theo số lượng tùy chọn

Thử:

Sub TH1()
    Dim Rng As Range, Cll As Range, k&
    Set Rng = Range(Range("C5"), Range("C" & Rows.Count).End(xlUp)).Resize(, 2)
    For Each Cll In Rng
        k = k + 1
        Cells(k + 4, 7) = Cll
    Next Cll
End Sub

Sub TH2()
    Dim i%, LR%
    LR = Cells(Rows.Count, 10).End(3).Row
    For i = 5 To LR
        Cells(i, 10).Copy Cells(i * 2 - 5, 13)
    Next
End Sub

 

[Phan Thế Hiệp]

Gửi bạn tham khảo
Riêng ví dụ 1, hàm mình sử dụng đang giả sử số lượng phần tử của 2 cột là bằng nhau (trong ví dụ đều là 3 phần tử). Nếu số lượng lệch nhau sẽ cần hàm phức tạp hơn hoặc thậm chí VBA

Nếu Ví dụ 2 không phải là số 1,2,3 thì sao!? dùng MAX() sẽ không phù hợp.

Góp vui thêm:

F5=INDEX($C$5:$D$7,CEILING(ROW(A1)/2,1),2-ISODD(ROW(A1)))
L5=IF(ISODD(ROW(A1)),OFFSET($J$4,CEILING(ROW(A1)/2,1),),"")

Enter, fill xuống.
Thân.

 

[congnt92]

Nếu Ví dụ 2 không phải là số 1,2,3 thì sao!? dùng MAX() sẽ không phù hợp.

Góp vui thêm:

F5=INDEX($C$5:$D$7,CEILING(ROW(A1)/2,1),2-ISODD(ROW(A1)))
L5=IF(ISODD(ROW(A1)),OFFSET($J$4,CEILING(ROW(A1)/2,1),),"")

Enter, fill xuống.
Thân.

Em quên mất, bị cuốn quá vào dữ liệu nên không đưa ra được phương án tổng quát .
Em đã upload lại file

 

[ndu96081631]

Mấy bài dạng này làm xong cũng không biết ứng dụng vào việc gì. Excel mà cứ làm như là PowerPoint, Word... vẽ vời linh tinh

 

[♫ђöล♥ßล†♥†µ♫]

Thử:

Sub TH1()
    Dim Rng As Range, Cll As Range, k&
    Set Rng = Range(Range("C5"), Range("C" & Rows.Count).End(xlUp)).Resize(, 2)
    For Each Cll In Rng
        k = k + 1
        Cells(k + 4, 7) = Cll
    Next Cll
End Sub

Sub TH2()
    Dim i%, LR%
    LR = Cells(Rows.Count, 10).End(3).Row
    For i = 5 To LR
        Cells(i, 10).Copy Cells(i * 2 - 5, 13)
    Next
End Sub

Em gom vào 1 Sub thôi anh ạ

Sub InputBox_Array()
    Dim sRng As Range, eRng As Range
    Dim sArr, dArr, I As Long, J As Long, K As Long, N As Long
On Error GoTo Thoat
Set sRng = Application.InputBox(Prompt:="Chon vung du lieu ", Title:="Chon du lieu dau vao", Type:=8)
sArr = sRng.Value
ReDim dArr(1 To 65535, 1 To 1)
K = 1
For I = LBound(sArr, 1) To UBound(sArr, 1)
    For J = LBound(sArr, 2) To UBound(sArr, 2)
        If sArr(I, J) <> Empty Then
            N = N + 1: dArr(K, 1) = sArr(I, J)
            K = IIf(UBound(sArr, 2) = 1, K + 2, K + 1)
        End If
    Next J
Next I
If N Then
    Set eRng = Application.InputBox(Prompt:="Chon 1 ô ", Title:="Chon o de dat ket qua ", Type:=8)
    eRng(1, 1).Resize(K) = dArr
Else
    MsgBox "Nothing"
End If
Thoat:
End Sub

 

[boycodon2405]

Mấy bài dạng này làm xong cũng không biết ứng dụng vào việc gì. Excel mà cứ làm như là PowerPoint, Word... vẽ vời linh tinh

Em ứng dụng vào làm chấm công thầy ạ. Mỗi người 26 công, mỗi công là 2 dòng nthe. Pm up công có layout như ví dụ 1 nên em phải tìm cách nhanh hơn chứ thầy

 

[SA_DQ]

Hai trong 1 cho bạn luôn:

Sub Chép_Công()
Dim Rng As Range
Dim J As Long, W As Long, Rws As Long

Set Rng = Application.InputBox(Prompt:="Chon Vùng Du Liêu ", Title:="Chon Du Liêu Dàu Vào", Type:=8)
Rws = Rng.Rows.Count
ReDim Arr(1 To 3 * Rws, 1 To 1)
[f5].Resize(9 * Rws).ClearContents
Select Case Rng.Columns.Count
Case 2     'Vùng Gòm 2 Côt         '
    For J = 1 To Rws
        Arr(J, 1) = Rng(1).Offset(J - 1)
        Arr(Rws + J, 1) = Rng(2).Offset(J - 1)
    Next J
Case 1     'Vùng Có 1 Côt          '
    For J = 1 To Rws
        Arr(2 * J - 1, 1) = Rng(1).Offset(J - 1)
    Next J
End Select
If J Then
    [f5].Resize(2 * Rws).Value = Arr()
End If
End Sub