Chuyển đổi dữ liệu

Liên hệ QC
N

ngvu20131003

Thành viên mới
Tham gia
2/3/20
Bài viết
17
Được thích
2
Yêu cầu đề bài: Cho 100 số ngẫu nhiên, từ A1:A100, sau đó chuyển theo quy luật sau:
+ A1:A10 thì chuyển qua thành B1:K1
+ A11:A20 thì chuyển qua thành B2:K2
...
(dữ liệu từ trái sang phải)
-------
Tương tự: Ziczac
Nghĩa là từ A1:A10 sẽ là từ B1:K1
A11:A20 theo thứ tự từ K2:B2
...
Bài đã được tự động gộp:

ngvu20131003 đã viết:
Yêu cầu đề bài: Cho 100 số ngẫu nhiên, từ A1:A100, sau đó chuyển theo quy luật sau:
+ A1:A10 thì chuyển qua thành B1:K1
+ A11:A20 thì chuyển qua thành B2:K2
...
(dữ liệu từ trái sang phải)
-------
Tương tự: Ziczac
Nghĩa là từ A1:A10 sẽ là từ B1:K1
A11:A20 theo thứ tự từ K2:B2
...
Nhấp chuột vào đây để mở rộng...
Sử dụng tất cả bằng VBA!
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Sao không có đầu cuối, xin chào, tạm biệt gì vậy bạn?

Không lẽ lại có chủ tịt tĩnh đi học. :(
 
Upvote 0
PHP: 
Sub ChuyenViTriCuaMang()
Dim W As Integer, J As Long
ReDim dArr(1 To 11, 1 To 11) As Integer
Dim Cls As Range

Randomize
For W = 1 To 10
    For J = 1 To 10
        dArr(W, J) = 1 + 999 * Rnd() \ 1
    Next J
Next W
[B1].Resize(10, 10).Value = dArr()
W = 0
For Each Cls In Range([B1], [K10])
    W = W + 1:                      Cells(W, "A").Value = Cls.Value
Next Cls
End Sub
 
Upvote 0
ngvu20131003 đã viết:
Rất xin lỗi tất cả mọi người nhiều ạ! Em vô ý quên mất, mong mọi người bỏ qua! Rất xin lỗi!
Nhấp chuột vào đây để mở rộng...
Biết nhận lỗi thì được, vậy thử code sau:

Mã: 
Sub LoopMuoiCell()
    Dim xCell As Range: Set xCell = Range("A1")
    Dim I As Long
    Application.ScreenUpdating = False
    While xCell.Value <> ""
        I = I + 1
        xCell.Resize(10).Copy
        Range("B" & I).PasteSpecial Transpose:=True
        Set xCell = xCell.Offset(10)
    Wend
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
"Ziczac [sic]" cái mốc khô gì.
Căn bản bài này là chuyển mảng 1 chiều thành 2 chiều - n phần tử thành n/10 dòng và 10 cột.
 
Upvote 0
batman1 đã viết:
[QUOTE="ngvu20131003, post: 957313, member: 1245782"
Tương tự: Ziczac
Nhấp chuột vào đây để mở rộng...
Ziczac là cái gì vậy bạn?
[/QUOTE]
Theo đề bài trong sách giải thích là: Từ A1:A10 chuyển sang B1:K1, từ A11:A20 chuyển sang K2:B2, từ A21:A30 chuyển sang B3:K3... tương tự vậy nha
Với dòng lẻ: viết từ trái qua phải.
Với dòng chẳn: viết từ phải qua trái.
 
Upvote 0
be09 đã viết:
Biết nhận lỗi thì được, vậy thử code sau:

Mã: 
Sub LoopMuoiCell()
    Dim xCell As Range: Set xCell = Range("A1")
    Dim I As Long
    Application.ScreenUpdating = False
    While xCell.Value <> ""
        I = I + 1
        xCell.Resize(10).Copy
        Range("B" & I).PasteSpecial Transpose:=True
        Set xCell = xCell.Offset(10)
    Wend
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Nhận lỗi mà không sửa cũng bằng thừa
 
Upvote 0
ngvu20131003 đã viết:
Ziczac là cái gì vậy bạn?
Nhấp chuột vào đây để mở rộng...
Theo đề bài trong sách giải thích là: Từ A1:A10 chuyển sang B1:K1, từ A11:A20 chuyển sang K2:B2, từ A21:A30 chuyển sang B3:K3... tương tự vậy nha
Với dòng lẻ: viết từ trái qua phải.
Với dòng chẳn: viết từ phải qua trái.
[/QUOTE]

Hãy suy nghĩ và sửa lại các bài theo như đề xuất ở bài #2 (thay vì nhắn tin xin lỗi, hay viết không)

befaint đã viết:
Sao không có đầu cuối, xin chào, tạm biệt gì vậy bạn?

Không lẽ lại có chủ tịt tĩnh đi học. :(
Nhấp chuột vào đây để mở rộng...

Viết như bạn là: Bạn giao việc này như kiểu thầy cô giao học trò, sếp giao nhân viên
Bài dạng này chắc hẳn là bài tập(?): nên tự làm trước mắc đâu hỏi đó, còn lấy code trọn vẹn từ các bài trả lời về thì cũng làm hỏng mục đích học của bài tập
 
Lần chỉnh sửa cuối:
Upvote 0
ngvu20131003 đã viết:
Yêu cầu đề bài: Cho 100 số ngẫu nhiên, từ A1:A100, sau đó chuyển theo quy luật sau:
+ A1:A10 thì chuyển qua thành B1:K1
+ A11:A20 thì chuyển qua thành B2:K2
...
(dữ liệu từ trái sang phải)
-------
Tương tự: Ziczac
Nghĩa là từ A1:A10 sẽ là từ B1:K1
A11:A20 theo thứ tự từ K2:B2
...
Bài đã được tự động gộp:


Sử dụng tất cả bằng VBA!
Nhấp chuột vào đây để mở rộng...
Cả ziczac & không
Mã: 
Sub abc_ziczac()
Dim Mang
Dim Kq1(1 To 100, 1 To 1) As Long, Kqozz(1 To 10, 1 To 10), Kqzz(1 To 10, 1 To 10)
Dim i, j, k, x, z, t
ReDim Mang(1 To 100)
For j = 1 To 100
    Mang(j) = j
Next j
k = 100
Randomize
Do While k > 0
    x = Rnd() * (k - 1) \ 1 + 1
    t = Mang(x)
    Mang(x) = Mang(k)
    k = k - 1
    Kq1(t, 1) = k
    i = Int((t - 1) / 10) + 1
    j = (t - 1) Mod 10 + 1
    Kqozz(i, j) = k
    If i Mod 2 = 0 Then
        z = 10 - j + 1
    Else
        z = j
    End If
    Kqzz(i, z) = k
Loop
With Sheet1
    .UsedRange.Clear
    .Range("A1:A100") = Kq1
    .Range("B1:K10") = Kqozz
    .Range("B12:K21") = Kqzz
End With
End Sub
 
Upvote 0
CHAOQUAY đã viết:
Cả ziczac & không
Mã: 
Sub abc_ziczac()
Dim Mang
Dim Kq1(1 To 100, 1 To 1) As Long, Kqozz(1 To 10, 1 To 10), Kqzz(1 To 10, 1 To 10)
Dim i, j, k, x, z, t
ReDim Mang(1 To 100)
For j = 1 To 100
    Mang(j) = j
Next j
k = 100
Randomize
Do While k > 0
    x = Rnd() * (k - 1) \ 1 + 1
    t = Mang(x)
    Mang(x) = Mang(k)
    k = k - 1
    Kq1(t, 1) = k
    i = Int((t - 1) / 10) + 1
    j = (t - 1) Mod 10 + 1
    Kqozz(i, j) = k
    If i Mod 2 = 0 Then
        z = 10 - j + 1
    Else
        z = j
    End If
    Kqzz(i, z) = k
Loop
With Sheet1
    .UsedRange.Clear
    .Range("A1:A100") = Kq1
    .Range("B1:K10") = Kqozz
    .Range("B12:K21") = Kqzz
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Dạ em xin cám ơn thầy nhiều ạ! Ban đầu em sử dụng cái code này
Sub BaiTap3()
Dim RanMin As Long
Dim RanMax As Long
RanMin = 0
RanMax = 100
Cells.Select
Selection.Delete Shift:=xlUp
Selection.Clear
For i = 1 To 100
Range("A" & i).Select
ActiveCell.FormulaR1C1 = Int((RanMax - RanMin) * Rnd() + RanMin)
Next i
Dim wb As Workbook
Dim sh As Worksheet
Set wb = ThisWorkbook
Set sh = wb.Sheets(1)
sh.Range("A1:A10").Cut Destination:=sh.Range("B1")
sh.Range("B1:K1").EntireColumn.AutoFit
sh.Range("A11:A20").Cut Destination:=sh.Range("B2")
sh.Range("B2:K2").EntireColumn.AutoFit
End Sub
-------
Kết quả là nó trả về toàn hàng dọc, kính mong các thầy xem giúp em code này bị lỗi chỗ nào mà nó bị trả về không đúng như đề bài nha. Em cám ơn rất nhiều ạ!
Bài đã được tự động gộp:

ngvu20131003 đã viết:
Dạ em xin cám ơn thầy nhiều ạ! Ban đầu em sử dụng cái code này
Sub BaiTap3()
Dim RanMin As Long
Dim RanMax As Long
RanMin = 0
RanMax = 100
Cells.Select
Selection.Delete Shift:=xlUp
Selection.Clear
For i = 1 To 100
Range("A" & i).Select
ActiveCell.FormulaR1C1 = Int((RanMax - RanMin) * Rnd() + RanMin)
Next i
Dim wb As Workbook
Dim sh As Worksheet
Set wb = ThisWorkbook
Set sh = wb.Sheets(1)
sh.Range("A1:A10").Cut Destination:=sh.Range("B1")
sh.Range("B1:K1").EntireColumn.AutoFit
sh.Range("A11:A20").Cut Destination:=sh.Range("B2")
sh.Range("B2:K2").EntireColumn.AutoFit
End Sub
-------
Kết quả là nó trả về toàn hàng dọc, kính mong các thầy xem giúp em code này bị lỗi chỗ nào mà nó bị trả về không đúng như đề bài nha. Em cám ơn rất nhiều ạ!
Nhấp chuột vào đây để mở rộng...
Cái này là của dạng thông thường nha thầy, không phải là ziczac
 
Upvote 0
1583421404381.png
Thôi thì cứ coi như đã xin lõi.

Code:
Const RGDULIEU = "A1:A100"
Const RGKETQUA = "B1"
Const SOCOT = 10
a = Application.Transpose(Range(RGDULIEU)).Value ' nạp dữ liệu vào mảng
Redim b(1 to UBound(a), 1 To SOCOT)
i2 = 0 ' khởi dòng và cột của mảng b
j2 = SOCOT
For i = 1 To UBound(a)
If j2 >= SOCOT Then ' dòng mới
i2 = i2 + 1
j2 = 0
End If
j2 = j2 + 1
b(i2, j2) = a(i)
Next i
Range(RGKETQUA).Resize(i2, SOCOT) = b

Với bài 2 thì đổi:
b(i2, j2) = a(i)
thành:
b(i2, IIF(i2 And 1, j2, SOCOT - j2 + 1)) = a(i)

Đã là bài tập thì chỉ dẫn đến đây nhiều rồi. Áp dụng và chỉnh lỗi là việc của học sinh.
 
Upvote 0
ngvu20131003 đã viết:
...Ban đầu em sử dụng cái code này

sh.Range("A1:A10").Cut Destination:=sh.Range("B1")
sh.Range("B1:K1").EntireColumn.AutoFit
sh.Range("A11:A20").Cut Destination:=sh.Range("B2")
sh.Range("B2:K2").EntireColumn.AutoFit
End Sub

...không phải là ziczac
Nhấp chuột vào đây để mở rộng...
Có lẽ là chỗ bôi đậm chưa đúng yêu cầu của bạn.
Đại khái là khi bạn cắt vùng A1:A10, sẽ được "1 cột". Nếu cứ thế mà dán xuống sheet sẽ thu được 1 cột, còn nếu muốn dán xuống theo hàng ngang thì phải dùng transpose()

Bạn làm thủ công thế này để theo dõi:
Mở record macro
Chọn A1:A10, nhấn ctrl+C
Chuyển ô hiện hành về B1 -> chuột phải -> chọn paster special -> tích chọn transpose -> nhấn ok -> nhấn esc để thoát.
Dừng thu macro rồi mở ra xem code sẽ thấy cách dùng transpose trong macro
 
Upvote 0
VetMini đã viết:
View attachment 232967
Thôi thì cứ coi như đã xin lõi.

Code:
Const RGDULIEU = "A1:A100"
Const RGKETQUA = "B1"
Const SOCOT = 10
a = Application.Transpose(Range(RGDULIEU)).Value ' nạp dữ liệu vào mảng
Redim b(1 to UBound(a), 1 To SOCOT)
i2 = 0 ' khởi dòng và cột của mảng b
j2 = SOCOT
For i = 1 To UBound(a)
If j2 >= SOCOT Then ' dòng mới
i2 = i2 + 1
j2 = 0
End If
j2 = j2 + 1
b(i2, j2) = a(i)
Next i
Range(RGKETQUA).Resize(i2, SOCOT) = b

Với bài 2 thì đổi:
b(i2, j2) = a(i)
thành:
b(i2, IIF(i2 And 1, j2, SOCOT - j2 + 1)) = a(i)

Đã là bài tập thì chỉ dẫn đến đây nhiều rồi. Áp dụng và chỉnh lỗi là việc của học sinh.
Nhấp chuột vào đây để mở rộng...
Em cảm ơn thầy nhiều nha! Chúc thầy ngủ ngon!
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Có lẽ là chỗ bôi đậm chưa đúng yêu cầu của bạn.
Đại khái là khi bạn cắt vùng A1:A10, sẽ được "1 cột". Nếu cứ thế mà dán xuống sheet sẽ thu được 1 cột, còn nếu muốn dán xuống theo hàng ngang thì phải dùng transpose()

Bạn làm thủ công thế này để theo dõi:
Mở record macro
Chọn A1:A10, nhấn ctrl+C
Chuyển ô hiện hành về B1 -> chuột phải -> chọn paster special -> tích chọn transpose -> nhấn ok -> nhấn esc để thoát.
Dừng thu macro rồi mở ra xem code sẽ thấy cách dùng transpose trong macro
Nhấp chuột vào đây để mở rộng...
Em đã làm được rồi! Em xin cám ơn thầy nhiều nha! Chúc thầy buổi tối vui vẻ!
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

tby211
Lỗi 1004 vba khi tách file trắc nghiệm sang excel
Trả lời
0
Đọc
16
tby211
tby211
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
6
Đọc
140
NguyenthiH
NguyenthiH
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
17
Đọc
508
ngochienbmt
N
N
Hàm if, lọc dữ liệu trùng
Trả lời
6
Đọc
6K
OANHMAI123
O
T
Xóa dòng theo điều kiện
Trả lời
1
Đọc
51
SA_DQ
SA_DQ
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom