这是我的代码：
Private Sub CopyRanges()
Sheets("Test2").Activate
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range(ActiveSheet.Columns("A"), ActiveSheet.Columns("A").End(xlDown)).Value = Range(Sheets("Test1").Columns(2), Sheets("Test1").Columns(2).End(xlDown)).Value
Range(ActiveSheet.Columns("B"), ActiveSheet.Columns("B").End(xlDown)).Value = Range(Sheets("Test1").Columns(23), Sheets("Test1").Columns(23).End(xlDown)).Value
Range(ActiveSheet.Columns("C:D"), ActiveSheet.Columns("C:D").End(xlDown)).Value = Range(Sheets("Test1").Columns(3), Sheets("Test1").Columns(3).End(xlDown)).Value
Range(ActiveSheet.Columns("E:F"), ActiveSheet.Columns("E:F").End(xlDown)).Value = Range(Sheets("Test1").Columns(4), Sheets("Test1").Columns(4).End(xlDown)).Value
Range(ActiveSheet.Columns("G:H"), ActiveSheet.Columns("G:H").End(xlDown)).Value = Range(Sheets("Test1").Columns(5), Sheets("Test1").Columns(5).End(xlDown)).Value
Range(ActiveSheet.Columns("I:J"), ActiveSheet.Columns("I:J").End(xlDown)).Value = Range(Sheets("Test1").Columns(6), Sheets("Test1").Columns(6).End(xlDown)).Value
Range(ActiveSheet.Columns("K:L"), ActiveSheet.Columns("K:L").End(xlDown)).Value = Range(Sheets("Test1").Columns(7), Sheets("Test1").Columns(7).End(xlDown)).Value
Range(ActiveSheet.Columns("M:N"), ActiveSheet.Columns("M:N").End(xlDown)).Value = Range(Sheets("Test1").Columns(8), Sheets("Test1").Columns(8).End(xlDown)).Value
Range(ActiveSheet.Columns("O:P"), ActiveSheet.Columns("O:P").End(xlDown)).Value = Range(Sheets("Test1").Columns(9), Sheets("Test1").Columns(9).End(xlDown)).Value
Range(ActiveSheet.Columns("Q:R"), ActiveSheet.Columns("Q:R").End(xlDown)).Value = Range(Sheets("Test1").Columns(10), Sheets("Test1").Columns(10).End(xlDown)).Value
Range(ActiveSheet.Columns("S:T"), ActiveSheet.Columns("S:T").End(xlDown)).Value = Range(Sheets("Test1").Columns(11), Sheets("Test1").Columns(11).End(xlDown)).Value
Range(ActiveSheet.Columns("U:V"), ActiveSheet.Columns("U:V").End(xlDown)).Value = Range(Sheets("Test1").Columns(12), Sheets("Test1").Columns(12).End(xlDown)).Value
Range(ActiveSheet.Columns("W:X"), ActiveSheet.Columns("W:X").End(xlDown)).Value = Range(Sheets("Test1").Columns(13), Sheets("Test1").Columns(13).End(xlDown)).Value
Range(ActiveSheet.Columns("Y:Z"), ActiveSheet.Columns("Y:Z").End(xlDown)).Value = Range(Sheets("Test1").Columns(14), Sheets("Test1").Columns(14).End(xlDown)).Value
Dim rCell As Range
Dim rRng As Range
For Each rCell In Range("C1:D800")
If rCell.Value = "Maximum accomodation in room is" Then
If rRng Is Nothing Then
Set rRng = rCell
Else
Set rRng = Application.Union(rRng, rCell)
End If
End If
Next
rRng.Offset(, 0).Select
Selection.EntireRow.Unmerge
Selection.HorizontalAlignment = xlGeneral
Columns("A").Replace What:=",99", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Columns("A").Replace What:=",00", Replacement:="", LookAt:= _
xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B5").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Run "ResizeAll"
End Sub
除时间外，Vba运作良好。程序需要7-10分钟，无法找到减少时间的解决方案。
提前致谢
答案 0 :(得分：0)
作为我的建议的一个例子，我改编了第一行，你可以尝试一下，我希望它能提高你的代码的性能。
let manager = FBSDKLoginManager()
manager.loginBehavior = FBSDKLoginBehavior.web
manager.logIn(withReadPermissions: ["public_profile", "email", "user_friends"], from: self, handler: { (pResult, pError) -> Void in
....
})
答案 1 :(得分：0)
关注代码的工作有点难 - 重新排列列并复制其中的一些？似乎Test2列C＆amp; D等于Test1第3列？
我找到了一些看起来可以加快速度的代码（https://www.mrexcel.com/forum/excel-questions/606890-reorder-columns-using-macro.html）
使用此方法将列排序为所需的顺序，并使用FIND而不是循环遍历每个单元格：
Private Sub CopyRanges()
Dim NewColOrder As Variant
Dim x As Long
Dim rLastCell As Range
Dim rFound As Range
Dim FirstFound As String
Dim rRng As Range
'This is the order you want the columns in.
'So the 26th column should be in position 2.
'Column 3 is repeated twice: Columns("C:D") = Columns(3) in your code.
NewColOrder = Array(1, 3, 3, 5, 5, 7, 7, 9, 9, 11, 11, 13, 13, 15, 15, 17, 17, 19, 19, 21, 21, 23, 23, 25, 25, 2)
With ThisWorkbook
With .Worksheets("Test1")
'Create copies of repeated columns.
For x = LBound(NewColOrder) + 1 To UBound(NewColOrder)
If NewColOrder(x) = NewColOrder(x - 1) Then
.Columns(NewColOrder(x)).EntireColumn.Insert Shift:=xlToRight
.Columns(NewColOrder(x) - 1).Copy Destination:=.Columns(NewColOrder(x))
End If
Next x
'Add a new row and put desired column order in row.
.Range("A1").EntireRow.Insert
.Range("A1").Resize(1, UBound(NewColOrder) + 1) = NewColOrder
'Find the last cell containing data.
Set rLastCell = .Cells.Find("*", , , , xlByRows, xlPrevious)
'Sort the data into the correct column order.
.Range(.Cells(1, 1), rLastCell).Sort .Cells(1), 1, Orientation:=xlLeftToRight
'Copy the data over to Test1.
.Range(.Cells(2, 1), rLastCell).Copy Destination:=ThisWorkbook.Worksheets("Test2").Range("A1")
End With
'Now to find "Maximum accomodation in room is"
With .Worksheets("Test2")
'Find the last cell containing data.
Set rLastCell = .Cells.Find("*", , , , xlByRows, xlPrevious)
With .Range(.Cells(3, 1), rLastCell)
Set rFound = .Find("Maximum accomodation in room is", LookIn:=xlValues)
If Not rFound Is Nothing Then
FirstFound = rFound.Address
Do
If rRng Is Nothing Then
Set rRng = rFound
Else
Set rRng = Union(rRng, rFound)
End If
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> FirstFound
End If
'Not quite sure what you're trying to do here.
If Not rRng Is Nothing Then
rRng.EntireRow.UnMerge
rRng.HorizontalAlignment = xlGeneral
End If
End With
.Columns(1).Replace What:=",99", Replacement:="", LookAt:=xlPart
.Columns(1).Replace What:=",00", Replacement:="", LookAt:=xlPart
End With
End With
End Sub
答案 2 :(得分：0)
我更改了代码的第一部分，现在比以前更快地工作了：
Private Sub CopyRanges（）
Dim wsTest2 As Worksheet，wsTest1 As Worksheet
Dim lr As Long
设置wsTest2 = ActiveWorkbook.Sheets（“Test2”）
设置wsTest1 = ActiveWorkbook.Sheets（“Test1”）
使用应用程序
.ScreenUpdating = False
.DisplayAlerts = False
结束
wsTest2.Activate
lr = wsTest1.UsedRange.Rows（wsTest1.UsedRange.Rows.Count）.Row
wsTest2.Range（“A1：A”＆amp; lr）.Value = wsTest1.Range（“B1：B”＆amp; lr）.Value
wsTest2.Range（“B1：B”＆amp; lr）.Value = wsTest1.Range（“W1：W”＆amp; lr）.Value
wsTest2.Range（“C1：D”＆amp; lr）.Value = wsTest1.Range（“C1：C”＆amp; lr）.Value
wsTest2.Range（“E1：F”＆amp; lr）.Value = wsTest1.Range（“D1：D”＆amp; lr）.Value
wsTest2.Range（“G1：H”＆amp; lr）.Value = wsTest1.Range（“E1：E”＆amp; lr）.Value
wsTest2.Range（“I1：J”＆amp; lr）.Value = wsTest1.Range（“F1：F”＆amp; lr）.Value
wsTest2.Range（“K1：L”＆amp; lr）.Value = wsTest1.Range（“G1：G”＆amp; lr）.Value
wsTest2.Range（“M1：N”＆amp; lr）.Value = wsTest1.Range（“H1：H”＆amp; lr）.Value
wsTest2.Range（“O1：P”＆amp; lr）.Value = wsTest1.Range（“I1：I”＆amp; lr）.Value
wsTest2.Range（“Q1：R”＆amp; lr）.Value = wsTest1.Range（“J1：J”＆amp; lr）.Value
wsTest2.Range（“S1：T”＆amp; lr）.Value = wsTest1.Range（“K1：K”＆amp; lr）.Value
wsTest2.Range（“U1：V”＆amp; lr）.Value = wsTest1.Range（“L1：L”＆amp; lr）.Value
wsTest2.Range（“W1：X”＆amp; lr）.Value = wsTest1.Range（“M1：M”＆amp; lr）.Value
wsTest2.Range（“Y1：Z”＆amp; lr）.Value = wsTest1.Range（“N1：N”＆amp; lr）.Value
'依旧......
End Sub