Nhờ các anh/chị giúp em VBA lật đối xứng vùng dữ liệu được chọn (các dòng có hình ảnh)

[donghavmu]

Chào anh chị. Em có bảng dữ liệu như trong file đính kèm (mỗi dòng đều chứa hình ảnh). Em muốn lật 1 vùng dữ liệu bất kì được chọn (từ dòng 6 trở đi mới có hiệu lực) (flip vertical) vì đang bị ngược thứ tự theo bản vẽ AutoCad sau khi em xuất từ AutoCad sang Excel. Em đã thử 2 code tìm được trên mạng (code có sẵn trong file) nhưng chỉ lật được giá trị chứ hình ảnh thì đứng im không đi theo dòng tương ứng. Mong mọi người viết giúp em vụ này với ạ. Em xin cảm ơn rất nhiều! (Thứ tự đúng từ trên xuống dưới sau khi lật là: MB1 - MB2- MB3 - DCT- GT22- CC1- CC2- BP - TĐ)

 

[batman1]

Bạn thử code sau.

Sub lat_doc()
Dim k As Long
    Application.ScreenUpdating = False
    For k = 1 To Selection.Rows.count
        Selection.Rows(k).Copy Selection(1 + Selection.Rows.count - k, 1).Offset(0, Selection.Columns.count)
    Next k
    
    Selection.Delete Shift:=xlToLeft
    Application.ScreenUpdating = True
End Sub

Lưu ý:
- Phải chọn toàn bộ dữ liệu. Tức hiện thời phải chọn tới cột X, nhưng do cột X bị ẩn nên chọn tới cột Y.
- Sau khi chạy code kiểm tra xem công thức thế nào vì tôi không kiểm tra. Dữ liệu trong một số ô ở dòng 17 có công thức.

 

[Maika8008]

Chào anh chị. Em có bảng dữ liệu như trong file đính kèm (mỗi dòng đều chứa hình ảnh). Em muốn lật 1 vùng dữ liệu bất kì được chọn (từ dòng 6 trở đi mới có hiệu lực) (flip vertical) vì đang bị ngược thứ tự theo bản vẽ AutoCad sau khi em xuất từ AutoCad sang Excel. Em đã thử 2 code tìm được trên mạng (code có sẵn trong file) nhưng chỉ lật được giá trị chứ hình ảnh thì đứng im không đi theo dòng tương ứng. Mong mọi người viết giúp em vụ này với ạ. Em xin cảm ơn rất nhiều! (Thứ tự đúng từ trên xuống dưới sau khi lật là: MB1 - MB2- MB3 - DCT- GT22- CC1- CC2- BP - TĐ)View attachment 273952

Tôi thấy code trong file chạy tốt mà, lật được.

 

[Phuocam]

1. Nhập số thứ tự bắt đầu từ 1 trong Y6.

2. Chọn toàn bộ dữ liệu, sắp xếp cột Y từ lớn đến nhỏ.

3. Xóa cột Y.

Xong.

 

[batman1]

Tôi thấy code trong file chạy tốt mà, lật được.

Các hình không chạy theo cùng dữ liệu.

 

[donghavmu]

Bạn thử code sau.

Sub lat_doc()
Dim k As Long
    Application.ScreenUpdating = False
    For k = 1 To Selection.Rows.count
        Selection.Rows(k).Copy Selection(1 + Selection.Rows.count - k, 1).Offset(0, Selection.Columns.count)
    Next k
   
    Selection.Delete Shift:=xlToLeft
    Application.ScreenUpdating = True
End Sub

Lưu ý:
- Phải chọn toàn bộ dữ liệu. Tức hiện thời phải chọn tới cột X, nhưng do cột X bị ẩn nên chọn tới cột Y.
- Sau khi chạy code kiểm tra xem công thức thế nào vì tôi không kiểm tra. Dữ liệu trong một số ô ở dòng 17 có công thức.

dạ code quá chuẩn luôn ạ, em cảm ơn anh rất nhiều ạ

 

[HUONGHCKT]

Chào anh chị. Em có bảng dữ liệu như trong file đính kèm (mỗi dòng đều chứa hình ảnh). Em muốn lật 1 vùng dữ liệu bất kì được chọn (từ dòng 6 trở đi mới có hiệu lực) (flip vertical) vì đang bị ngược thứ tự theo bản vẽ AutoCad sau khi em xuất từ AutoCad sang Excel. Em đã thử 2 code tìm được trên mạng (code có sẵn trong file) nhưng chỉ lật được giá trị chứ hình ảnh thì đứng im không đi theo dòng tương ứng. Mong mọi người viết giúp em vụ này với ạ. Em xin cảm ơn rất nhiều! (Thứ tự đúng từ trên xuống dưới sau khi lật là: MB1 - MB2- MB3 - DCT- GT22- CC1- CC2- BP - TĐ)View attachment 273952

Góp vui thêm một cách cho bạn tham khảo.
Bôi đen( chọn 1 cột (cột A) hoặc cả vùng Từ cột A tới cột nào đó). nhấn nút Run, ====> kiểm tra kết quả.
Code củ chuối được sửa từ code cũ và Ghi Macro

Sub FlipVerically()
Dim LastRow As Variant, LastCol As Variant
Dim StartNum As Integer
Dim Ws As Worksheet
Application.ScreenUpdating = False
StartNum = 1
LastRow = Selection.Rows.count
LastCol = Selection.Columns.count
Set Rng = Selection
Set Ws = Sheets("ThongKe")
For i = 1 To LastRow
    Rng(i, LastCol).Offset(0, 100) = i
Next i
    Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add2 Key:=Range(Rng(1, LastCol + 100), Rng(LastRow, LastCol + 100)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("ThongKe").Sort
        .SetRange Range(Rng(1, 1), Rng(LastRow, LastCol + 100))
        .Apply
    End With
    Ws.Cells(1, LastCol + 100).Resize(1000).ClearContents

Application.ScreenUpdating = True
End Sub

 

[huhumalu]

Thống kê thép có delta TIP, mình chưa thấy công cụ thống kê bằng tay nào qua được cái này.
Miễn phí, đồ họa đẹp, chèn vào AutoCAD bằng đối tượng (text, line, ...) thay vì hình ảnh, in ra sắc nét.