| 网站首页 | 业界新闻 | 小组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛

```Sub getOrder()
'按一定规律取值到数组,并输出到表2
'Code by:厨师王德榜
'2019-11-27
Dim iLR As Integer  '-1/+1 向左还是向右
Dim irow As Integer, icolN As Integer
Dim icolStart As Integer, icolEnd As Integer
Dim arr1()  As Integer
icolN = 1
icolEnd = 1
iLR = -1
ReDim arr1(41 - 4)
Worksheets("Sheet1").Activate
Application.ScreenUpdating = False
Do Until Cells(4, (icolN - 1) * 8 + 1).Text = ""
For irow = 4 To 41
If irow = 4 Then
iLR = -1
icolStart = (icolN - 1) * 8 + 2
Else
If (icolStart + 1) Mod 8 = 0 Or icolStart Mod 8 = 1 Then
iLR = iLR * -1
End If
End If
If icolStart = 0 Then icolStart = 1
arr1(irow - 4) = Cells(irow, icolStart).Value
Cells(irow, icolStart).Select
With Selection.Font
.Color = -16777024
.Bold = True
End With
icolStart = icolStart + iLR
icolEnd = IIf(icolStart > icolEnd, icolStart, icolEnd)
Next irow
'输出数组(到Sheet2):
Worksheets("Sheet2").Activate
Cells(4, icolN).Resize(38, 1) = Application.Transpose(arr1)
ReDim arr1(41 - 4)  '输出后,清空数组,方便给下一轮使用.
Worksheets("Sheet1").Activate
icolN = icolN + 1
Loop
Application.ScreenUpdating = True
MsgBox "计算完毕。最末列探测到第" & icolEnd & "列."
End Sub
```

第二是感谢！
第三是谢谢！+感谢！
• 6
• 1/1页
• 1