楼主
wp8680 |
题：
答：
- Sub 重排区域()
- Dim rng As Range, target As Range, arr, brr, a%, b%, x%, y%, R, S
- Dim k1%, k2%, m1%, m2%, k%
- On Error Resume Next
- ok1:
- Set rng = Application.InputBox("请选择数据源区。", "提示：", , , , , , 8)
- If rng Is Nothing Then Err.Clear: GoTo ok1
- ok2:
- Set target = Application.InputBox("请选择数据存放区。", "提示：", , , , , , 8)
- If target Is Nothing Then Err.Clear: GoTo ok2
- arr = rng.Value
- a = UBound(arr, 1)
- b = UBound(arr, 2)
- brr = target.Value
- x = UBound(brr, 1)
- y = UBound(brr, 2)
- m1 = 1
- m2 = 1
- If a * b > x * y Then MsgBox "你选择的存放区单元格数量小于数据源区，可能有部分数据不能显示！"
- R = MsgBox("数据源提取数据顺序，点“是”按行提取，点“否”按列提取", vbYesNo, "请选择数据提取顺序：")
- S = MsgBox("数据的存放顺序，点“是”按行存放，点“否”按列存放", vbYesNo, "请选择数据存放顺序：")
- For k1 = 1 To IIf(R = 6, a, b)
- For k2 = 1 To IIf(R = 6, b, a)
- k = k + 1
- If k > x * y Then Exit For
- brr(IIf(S = 6, m1, m2), IIf(S = 6, m2, m1)) = arr(IIf(R = 6, k1, k2), IIf(R = 6, k2, k1))
- m2 = m2 + 1
- If m2 = IIf(S = 6, y, x) Then m1 = m1 + 1: m2 = 1
- Next k2
- Next k1
- target.Value = brr
- End Sub
 工作簿1.rar
|