Giúp code đảo ngược dữ liệu trong 1 vùng

minhtuan55 · 23/10/18

Chào cả nhà GPE ! Em cần 1 đoạn code để đảo ngược từ dưới lên trên như hình bên dưới. Xin chân thành cảm ơn

saobekhonglac · 23/10/18

minhtuan55 đã viết:
Chào cả nhà GPE ! Em cần 1 đoạn code để đảo ngược từ dưới lên trên như hình bên dưới. Xin chân thành cảm ơn

View attachment 206224

Bắc ghế ngồi xem học hỏi.

snow25 · 23/10/18

minhtuan55 đã viết:
Chào cả nhà GPE ! Em cần 1 đoạn code để đảo ngược từ dưới lên trên như hình bên dưới. Xin chân thành cảm ơn

View attachment 206224

bạn lắp code này vào xem thế nào nhé

Mã:

Sub daonguoc()
Dim i, j, a As Long
Dim arr, arr1
arr = Sheets(1).Range("c5:e11").Value
ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
For i = UBound(arr, 1) To 1 Step -1
a = a + 1
  For j = 1 To UBound(arr, 2)
  arr1(a, j) = arr(i, j)
  Next j
Next i
Sheets(1).Range("l5").Resize(a, UBound(arr, 2)).Value = arr1
End Sub

VetMini · 23/10/18

snow25 đã viết:

bạn lắp code này vào xem thế nào nhé

Mã:

Sub daonguoc()
Dim i, j, a As Long
Dim arr, arr1
arr = Sheets(1).Range("c5:e11").Value
ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
For i = UBound(arr, 1) To 1 Step -1
a = a + 1
  For j = 1 To UBound(arr, 2)
  arr1(a, j) = arr(i, j)
  Next j
Next i
Sheets(1).Range("l5").Resize(a, UBound(arr, 2)).Value = arr1
End Sub

Cách dùng 1 mảng thôi:
i1 = 1
i2 = UBound(arr)
jj = UBound(arr,2)
Do While i2 > i1
For j = 1 to jj
tmp = arr(i1, j)
arr(i1,j) = arr(i2,j)
arr(i2,j) = tmp
i1 = i1 + 1
i2 = i2 - 1
Next j1
Loop

Hoàng Nhật Phương · 23/10/18

VetMini đã viết:
Cách dùng 1 mảng thôi:
i1 = 1
i2 = UBound(arr)
jj = UBound(arr,2)
Do While i2 > i1
For j = 1 to jj
tmp = arr(i1, j)
arr(i1,j) = arr(i2,j)
arr(i2,j) = tmp
i1 = i1 + 1
i2 = i2 - 1
Next j1
Loop

Xin chào bác VetMini, cháu thử viết theo gợi ý của Bác.
Code báo lỗi ở dòng: Next j1 ,cháu sửa lại Next j
Nhưng kết quả không giống với kết quả minh họa tại bài 1:

Mã:

Sub daonguoc2()
    Dim i1, i2, jj, tmp, arr
    arr = Sheets(1).Range("C5:E11").Value
        i1 = 1
        i2 = UBound(arr)
        jj = UBound(arr, 2)
    Do While i2 > i1
        For j = 1 To jj
            tmp = arr(i1, j)
            arr(i1, j) = arr(i2, j)
            arr(i2, j) = tmp
            i1 = i1 + 1
            i2 = i2 - 1
        Next j 'j1
    Loop
    Sheets(1).Range("L5").Resize(i1, UBound(arr, 2)).Value = arr
End Sub

Nhờ bác chỉ giúp cháu chỗ sai ạ.

CHAOQUAY · 23/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào bác VetMini, cháu thử viết theo gợi ý của Bác.
Code báo lỗi ở dòng: Next j1 ,cháu sửa lại Next j
Nhưng kết quả không giống với kết quả minh họa tại bài 1:

Mã:

Sub daonguoc2() Dim i1, i2, jj, tmp, arr arr = Sheets(1).Range("C5:E11").Value i1 = 1 i2 = UBound(arr) jj = UBound(arr, 2) Do While i2 > i1 For j = 1 To jj tmp = arr(i1, j) arr(i1, j) = arr(i2, j) arr(i2, j) = tmp i1 = i1 + 1 i2 = i2 - 1 Next j 'j1 Loop Sheets(1).Range("L5").Resize(i1, UBound(arr, 2)).Value = arr End Sub

Nhờ bác chỉ giúp cháu chỗ sai ạ.

Tham gia ngoài lề
Có lẽ phải chuyển

Mã:

i1 = i1 + 1
i2 = i2 - 1

ra ngoài vòng lặp for ... next
Thay i1 thành Ubound(arr) trong câu lệnh dưới

Mã:

Sheets(1).Range("L5").Resize(i1, UBound(arr, 2)).Value = arr

SA_DQ · 23/10/18

Với dữ liệu như của bạn chủ bài đăng, ta có thể xài:

PHP:

Sub LatDuLieu()
Dim Rng As Range
Dim Col As Byte, Dg As Long
Set Rng = [c5].CurrentRegion
' MsgBox Rng.Columns.Count, , Rng.Rows.Count    '
ReDim Arr(1 To Rng.Rows.Count, 1 To Rng.Columns.Count)
For Col = 1 To Rng.Columns.Count
    For Dg = 1 To Rng.Rows.Count
        Arr(Rng.Rows.Count - Dg + 1, Col) = Rng.Cells(Dg, Col)
    Next Dg
Next Col
[l5].Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Arr()
End Sub

Hoàng Nhật Phương · 23/10/18

CHAOQUAY đã viết:
Tham gia ngoài lề
Có lẽ phải chuyển

Mã:

i1 = i1 + 1 i2 = i2 - 1

ra ngoài vòng lặp for ... next
Thay i1 thành Ubound(arr) trong câu lệnh dưới

Mã:

Sheets(1).Range("L5").Resize(i1, UBound(arr, 2)).Value = arr

Xin chào CHAOQUAY,
Cảm ơn bạn đã chỉ giáo, thì ra: thay i1 thành Ubound(arr)

VetMini · 23/10/18

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào bác VetMini, cháu thử viết theo gợi ý của Bác.
Code báo lỗi ở dòng: Next j1 ,cháu sửa lại Next j
Nhưng kết quả không giống với kết quả minh họa tại bài 1:

Mã:

Sub daonguoc2() Dim i1, i2, jj, tmp, arr arr = Sheets(1).Range("C5:E11").Value i1 = 1 i2 = UBound(arr) jj = UBound(arr, 2) Do While i2 > i1 For j = 1 To jj tmp = arr(i1, j) arr(i1, j) = arr(i2, j) arr(i2, j) = tmp i1 = i1 + 1 i2 = i2 - 1 Next j 'j1 Loop Sheets(1).Range("L5").Resize(i1, UBound(arr, 2)).Value = arr End Sub

Nhờ bác chỉ giúp cháu chỗ sai ạ.

Xin lỗi, tối buồn ngủ quá, viết tùm lum hết
Do While i2 > i1
For j = 1 To jj
tmp = arr(i1, j)
arr(i1, j) = arr(i2, j)
arr(i2, j) = tmp
Next j
i1 = i1 + 1
i2 = i2 - 1
Loop

Hoàng Nhật Phương · 23/10/18

VetMini đã viết:
Xin lỗi, tối buồn ngủ quá, viết tùm lum hết
Do While i2 > i1
For j = 1 To jj
tmp = arr(i1, j)
arr(i1, j) = arr(i2, j)
arr(i2, j) = tmp
Next j
i1 = i1 + 1
i2 = i2 - 1
Loop

Cảm ơn bác VetMini, code OK rồi ạ.
Bác giữ gìn sức khỏe ạ,chúc bác ngủ ngon!

VetMini · 23/10/18

Đảo nghịch mảng là bài kinh điển (classic) của giáo khoa lập trình.
Hầu hết các giải thuật đều cho hai con trỏ từ hai đầu chạy về hội tụ ở giữa.

Hoàng Nhật Phương · 24/10/18

SA_DQ đã viết:

Với dữ liệu như của bạn chủ bài đăng, ta có thể xài:

PHP:

Sub LatDuLieu()
Dim Rng As Range
Dim Col As Byte, Dg As Long
Set Rng = [c5].CurrentRegion
' MsgBox Rng.Columns.Count, , Rng.Rows.Count    '
ReDim Arr(1 To Rng.Rows.Count, 1 To Rng.Columns.Count)
For Col = 1 To Rng.Columns.Count
    For Dg = 1 To Rng.Rows.Count
        Arr(Rng.Rows.Count - Dg + 1, Col) = Rng.Cells(Dg, Col)
    Next Dg
Next Col
[l5].Resize(Rng.Rows.Count, Rng.Columns.Count).Value = Arr()
End Sub

Xin chào bác SA_DQ,
Nhờ bác giải thích giúp cháu hiểu thêm 2 vấn đề này với ạ:

Set Rng = [c5].CurrentRegion
MsgBox Rng.Columns.Count, , Rng.Rows.Count

Kết quả trả về 3, và 7

Vấn đề 1. Nhưng khi gán Rng.Columns.Count, Rng.Rows.Count vào biến thì không được.

Mã:

    Dim i1 As Integer, i2 As Integer, arr ()
    i1 = Rng.Rows.Count
    i2 = Rng.Columns.Count
    arr(1 To i1, 1 To i2)

Có phải khi đưa Rng.Columns.Count, Rng.Rows.Count thông qua MsgBox thì
Rng = [c5].CurrentRegion bắt đầu được gọi ra, con khi gán cho 2 biến i1,i2 thì Rng = [c5].CurrentRegion chưa được gọi ?

Vấn đề 2. Khai báo

ReDim arr(1 To Rng.Rows.Count, 1 To Rng.Columns.Count)
hoặc:
Dim arr(1 To 7, 1 To 3)

thì kết quả vẫn OK. Vậy 2 cách khai báo này có gì giống và khác nhau ? Nhờ bác giải thích giúp cháu về ReDim với ạ.

batman1 · 24/10/18

Như bác VetMini nói, nguyên tắc hoán vị 2 phần tử là người ta nhớ "phần tử 1" ra "chỗ tạm thời" -> cho phần tử 1 bằng phần tử 2 -> cho phần tử 2 = "chỗ tạm thời". Ví dự điển hình là ta dùng hoán vị trong thuật toán QuickSort (6 năm trước tôi đã phải chiến đấu với nhiều người khi họ không hiểu ý nghĩa QuickSort của tôi
https://www.giaiphapexcel.com/diend...g-nhờ-test-hộ-và-góp-ý.71326/post-437489

https://www.giaiphapexcel.com/diendan/threads/bàn-về-thuật-toán-sort-mảng.83744/post-521122)
.
Phần tử 1 nằm ở nửa trên, phần tử 2 nằm ở nửa dưới. Chỉ cần duyệt FOR ở nửa trên (hoặc dưới). Tổng chỉ số dòng của 2 phần tử luôn không đổi và bằng Ubound(Arr) + 1

Mã:

Sub reverse()
Dim r As Long, c As Long, k As Long
Dim Arr, tmp
    Arr = ThisWorkbook.Worksheets("Sheet1").Range("C5:E11").Value
    k = UBound(Arr) + 1
    For r = 1 To UBound(Arr) \ 2
        For c = 1 To UBound(Arr, 2)
            tmp = Arr(r, c)
            Arr(r, c) = Arr(k - r, c)
            Arr(k - r, c) = tmp
        Next c
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("H5").Resize(UBound(Arr), UBound(Arr, 2)).Value = Arr
End Sub

SA_DQ · 24/10/18

Sau khi đọc bài của Batman1, mình thấy cần viết thử lại macro của mình;
Tuy nhiên do bạn hỏi cụ thể 2 lệnh:

Nhờ bác giải thích giúp cháu hiểu thêm 2 vấn đề này với ạ:
Set Rng = [c5].CurrentRegion
MsgBox Rng.Columns.Count, , Rng.Rows.Count
Kết quả trả về 3, và 7

thì mình xin giải thích tỉ mĩ cho bạn:

Thứ nhất ta cần hiểu fương thức CurrentRegion (dịch nôm na là 1 vùng ô liên tục)
Để vậy bạn thử 2 câu lệnh này:

Mã:

Set Rng = [c5].CurrentRegion
MsgBox Rng.Address

& tự rút ra kết luận cần thiết; Ví dụ dữ liệu tại #1 mà ta bỏ thử lần lượt các cột F & G bạn sẽ thấy vấn đề của fương thức này thôi!

Thứ 2, câu lệnh sau mình đã vô hiệu hóa rồi & chỉ là để đó để ai (giống như bạn,. . . ) cần thì đem ra kiểm tra mà thôi

Còn viết như bạn:

PHP:

 Dim i1 As Integer, i2 As Integer, arr ()
    i1 = Rng.Rows.Count
    i2 = Rng.Columns.Count
    arr(1 To i1, 1 To i2)

Cần kiểm tra thử xem 2 tham biến i1 & i2 đang chứa trị có như bạn mong mõi hay không?

Chúc ngày làm việc hôm nay hiệu quả mĩ mãm!

HeSanbi · 24/10/18

Lỡ đảo rồi thì đảo ngang đảo dọc cho vui

Mã:

Sub test_revs2D()
    Dim arr: arr = revs2D(Range("C5:E11"), True, True)
    Znew.Range("E13").Resize(UBound(arr), UBound(arr, 2)).ClearContents
    Znew.Range("E13").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub
    Function revs2D(ByVal rng As Range, Optional ByVal TOtoBO As Boolean, Optional ByVal BeToAf As Boolean) As Variant
        If Not IsArray(rng) Then revs2D = rng: Exit Function
        Dim i As Long, j As Long, V As Long, H As Long,  revsH, revsV, arr, dArr
        arr = rng.Value
        revsV = UBound(arr) + 1
        revsH = UBound(arr, 2) + 1
        ReDim dArr(1 To UBound(arr), 1 To UBound(arr, 2))
        For i = 1 To UBound(arr)
            V = i: If TOtoBO Then V = revsV - i
            For j = 1 To UBound(arr, 2)
                H = j: If BeToAf Then H = revsH - j
                dArr(V, H) = arr(i, j)
            Next j
        Next i
        revs2D = dArr
    End Function

chiendich · 24/10/18

minhtuan55 đã viết:
Chào cả nhà GPE ! Em cần 1 đoạn code để đảo ngược từ dưới lên trên như hình bên dưới. Xin chân thành cảm ơn

View attachment 206224

Chủ thớt này thật là vô tâm. mỗi lần nhờ mọi người viết code đều như vậy....! có code ôm đi là chạy mất dép. không có một lời cảm ơn người khác. Không biết mọi người có ý kiến gì không?

saobekhonglac · 24/10/18

chiendich đã viết:
Chủ thớt này thật là vô tâm. mỗi lần nhờ mọi người viết code đều như vậy....! có code ôm đi là chạy mất dép. không có một lời cảm ơn người khác. Không biết mọi người có ý kiến gì không?

Có thể chủ thớt chưa biết "like'. Mình vô GPE từ 2008 mà mỗi lần nhờ xong cũng chỉ biết trả lời cám ơn chứ không biết vụ like, sau này mới biết thôi. hihi

VetMini · 24/10/18

Thuật toán của bác batman1 ở bài #13 đúng là hữu hiệu nhất ở đây. Vì thực tế vòng lặp chỉ cần xét lặp qua phân nửa số phần tử đầu và mỗi phần tử tự liên hệ đến phần tử tương ứng của nó trong nửa còn lại.

Ỏ trên, bài #11, tôi nói về thuật toán 2 đầu chạy về nhau là vì tôi lẫn với ngôn ngữ C (quả là tối qua buồn ngủ thật). C dùng con trỏ mảng và toán tử tự tăng/giảm (auto increment/decrement) cho nên code rất gọn và hữu hiệu.

ndu96081631 · 24/10/18

minhtuan55 đã viết:
Chào cả nhà GPE ! Em cần 1 đoạn code để đảo ngược từ dưới lên trên như hình bên dưới. Xin chân thành cảm ơn

View attachment 206224

- Đánh số thứ tự cho cột B từ nhỏ đến lớn
- Sort dữ liệu giảm dần theo cột B (cột STT vừa thêm)
vậy là xong, tưởng không còn gì dễ hơn nữa

khi ta 20 · 24/10/18

saobekhonglac đã viết:
Có thể chủ thớt chưa biết "like'. Mình vô GPE từ 2008 mà mỗi lần nhờ xong cũng chỉ biết trả lời cám ơn chứ không biết vụ like, sau này mới biết thôi. hihi

Chuẩn bị có 1 phần mềm mới xuất xưởng tung ra thị trường với phiên bản "Vơ Sình Niu"

Giúp code đảo ngược dữ liệu trong 1 vùng

Thành viên bị đình chỉ hoạt động

File đính kèm

Thành viên mới

Thành viên gạo cội

Ăn cùng góc phố

Thành viên gắn bó

Thành viên gắn bó

/(hông là gì!

Thành viên gắn bó

Ăn cùng góc phố

Thành viên gắn bó

Ăn cùng góc phố

Thành viên gắn bó

Thành viên gạo cội

/(hông là gì!

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Lỡ bước sang ngang

Thành viên mới

Ăn cùng góc phố

Huyền thoại GPE

Thành viên thường trực

Đếm ngược thời gian