在excel VBA中两个或多个数组应该如何合并为一个数组

1、首先打开电脑上的excle表格。

2、然后进入VBA的编程界面，新建一个子过程bianliang。

3、在子过程中定义一个变量，这个变量是一个数组，类型是字符串类型，有3个元素，Dim city(3) As String。

4、为数组的3个元素各自赋值city(1) = "meizhou"city(2) = "shanghai"city(3) = "guangzhou"。

5、将数组的3个元素的值打出来。MsgBox "第一个城市是" & city(1) & "第二个城市是" & city(2) & "第三个城市是" & city(3)。

6、最后选择窗口顶部菜单的“运行”按钮，就完成了。

把sheet2和sheet3合并到sheet1

Sheets("Sheet2")Select 选中sheet2

Range("A2:B9")Select 选中要拷贝的范围

SelectionCopy 拷贝

Sheets("Sheet1")Select 选中sheet1

Range("A2")Select 选中要粘贴的范围。

ActiveSheetPaste 粘贴

Sheets("Sheet3")Select 选中sheet3

Range("A2:B9")Select 选中要拷贝的范围

SelectionCopy 拷贝

Sheets("Sheet1")Select 选中sheet1

Range("C2")Select 选中要粘贴的范围

ActiveSheetPaste 粘贴

Range("E2")Select

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range     

Dim Bloo As Boolean

Set Rng = TargetParentRange("Moving_Stock_out")

 If TargetCount > 1 Then Exit Sub

 If Intersect(Target, Rng) Is Nothing Then 

    Bloo = True

else

    Bloo=False

End If

If Bloo Then

   Range("Acutal_Balance")Value = Range("Actual_Balance")Value + Range("Moving_Stock_in")Value

Else

   TargetOffset(, 15)Value = Date

End If

End Sub

加个 布尔值转换一下

简单组合，试一下：

Sub 拆分工作表()

Dim myRange As Variant

Dim myArray

Dim titleRange As Range

Dim title As Variant

Dim columnNum As Integer

myRange = ApplicationInputBox(prompt:="请选择标题行：", Type:=8)

myArray = WorksheetFunctionTranspose(myRange)

Set titleRange = ApplicationInputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：“组织”", Type:=8)

title = titleRangeValue

columnNum = titleRangeColumn

ApplicationScreenUpdating = False

ApplicationDisplayAlerts = False

Dim i&, Myr&, Arr, num&

Dim d, k

For i = SheetsCount To 1 Step -1

If Sheets(i)Name <> "数据" Then

End If

Next i

Set d = CreateObject("ScriptingDictionary")

Myr = Worksheets("数据")UsedRangeRowsCount

Arr = Worksheets("数据")Range(Cells(2, columnNum), Cells(Myr, columnNum))

For i = 1 To UBound(Arr)

d(Arr(i, 1)) = ""

Next

k = dkeys

For i = 0 To UBound(k)

Set conn = CreateObject("adodbconnection")

connOpen "provider=MicrosoftACEOLEDB120;extended properties=Excel 120;Data Source=" & ThisWorkbookFullName

Sql = "select from [数据$] where " & title & " = '" & k(i) & "'"

WorksheetsAdd after:=Sheets(SheetsCount)

With ActiveSheet

Name = k(i)

For num = 1 To UBound(myArray)

Cells(1, num) = myArray(num, 1)

Next num

Range("A2")CopyFromRecordset connExecute(Sql)

End With

Sheets(1)Select

Sheets(1)CellsSelect

SelectionCopy

Worksheets(SheetsCount)Activate

ActiveSheetCellsSelect

SelectionPasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

ApplicationCutCopyMode = False

Next i

connClose

Set conn = Nothing

ApplicationDisplayAlerts = True

ApplicationScreenUpdating = True

call 另存工作表

End Sub

Private Sub 另存工作表()

Dim sht As Worksheet

Dim MyBook As Workbook

Set MyBook = ActiveWorkbook

For Each sht In MyBookSheets

shtCopy

ActiveWorkbookSaveAs Filename:=MyBookPath & "\" & shtName, FileFormat:=xlOpenXMLWorkbook '将工作簿另存为xlsx格式

ActiveWorkbookClose

Next

MsgBox "文件已经被分拆完毕!"

End Sub

Sub test()

Dim i, j, t, s, mark, arr, dic, n

Set dic = CreateObject("scriptingdictionary")

mark = Split("“ ” , !")

arr = [a1]CurrentRegionValue

ReDim brr(1 To RowsCount, 1 To 1)

For i = 1 To UBound(arr, 1)

For j = 0 To UBound(mark)

arr(i, 1) = Replace(arr(i, 1), mark(j), Space(1))

Next

t = Split(arr(i, 1), Space(1))

For j = 0 To UBound(t)

If Len(t(j)) Then

If InStr(t(j), "'") Then s = Split(t(j), "'")(0) Else s = t(j)

If Not dicexists(LCase(s)) Then

n = n + 1: brr(n, 1) = s

dic(LCase(s)) = vbNullString

End If

End If

Next j, i

With [b:b]: ClearContents: Resize(n) = brr: End With

竹 '调用 竹 这个程序

End Sub

Sub 竹()

Dim i&, j&, Str

Dim arr

ApplicationScreenUpdating = False

For Each Rng In Range("a1:a" & Cells(RowsCount, 1)End(3)Row)

arr = Split(Rng, " ")

For i = 0 To UBound(arr)

For j = 1 To Len(arr(i))

If Mid(arr(i), j, 1) Like "[a-z]" And Mid(arr(i), j + 1, 1) Like "[a-z]" Then

Str = Str & " " & arr(i)

Exit For

End If

Next j

Next i

RngOffset(0, 1) = Str

Str = ""

Next

ApplicationScreenUpdating = True

End Sub

上面代码改为

Sub 合并()

Dim rng As Range, i As Long

For Each rng In Range("k9:k458")

  i = i + 1

 If i Mod 3 = 1 Then

    rngResize(3, 1)Merge

 End If

Next rng

End Sub

*** 作方法

Excel数据重复或+空格怎样批量合并单元格

以上就是关于在excel VBA中两个或多个数组应该如何合并为一个数组全部的内容，包括:在excel VBA中两个或多个数组应该如何合并为一个数组、excel 两段VBA两段代码合并，，、VBA我要怎么合并这两个代码高手帮忙等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！