vba吧 关注：17,091贴子：66,918
- 20回复贴，共1页
不感兴趣
开通SVIP免广告
Option Explicit
Sub 两表间传送()
Dim shtFrom As Worksheet, shtTo As Worksheet
Dim i%, iEnd%, arr(), u%, boxID$, ii%, iBoxCount%
'Dim rngBoxID As Range
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
'我当你的《明细》表没有柜号，靠代码按顺序填写，而且每一个柜号占22行
Set shtFrom = ThisWorkbook.Sheets("设备明细表")
Set shtTo = ThisWorkbook.Sheets("明细")
'iEnd = shtFrom.Range("B65536").End(xlUp).Offset(1, 0).Row - 1
'for each rngBoxID in
'iBoxCount = 0
arr = shtFrom.Range("A3").网页链接 u = UBound(arr)
With shtTo
For i = 2 To u
If Len(arr(i, 2)) Then
boxID = arr(i, 2)
ii = iBoxCount * 22 + 1
iBoxCount = iBoxCount + 1 '柜号+1
.Cells(ii, 2).Value = boxID
ii = ii + 2
Else
ii = ii + 1
End If
.Cells(ii, 2).Value = arr(i, 3) ' 元件名称
.Cells(ii, 3).Value = arr(i, 4) ' 型号规格
.Cells(ii, 4).Value = arr(i, 5) ' 单位
.Cells(ii, 5).Value = arr(i, 6) ' 数量
Next
End With
End Sub
Sub 两表间传送()
Dim shtFrom As Worksheet, shtTo As Worksheet
Dim i%, iEnd%, arr(), u%, boxID$, ii%, iBoxCount%
'Dim rngBoxID As Range
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
'我当你的《明细》表没有柜号，靠代码按顺序填写，而且每一个柜号占22行
Set shtFrom = ThisWorkbook.Sheets("设备明细表")
Set shtTo = ThisWorkbook.Sheets("明细")
'iEnd = shtFrom.Range("B65536").End(xlUp).Offset(1, 0).Row - 1
'for each rngBoxID in
'iBoxCount = 0
arr = shtFrom.Range("A3").网页链接 u = UBound(arr)
With shtTo
For i = 2 To u
If Len(arr(i, 2)) Then
boxID = arr(i, 2)
ii = iBoxCount * 22 + 1
iBoxCount = iBoxCount + 1 '柜号+1
.Cells(ii, 2).Value = boxID
ii = ii + 2
Else
ii = ii + 1
End If
.Cells(ii, 2).Value = arr(i, 3) ' 元件名称
.Cells(ii, 3).Value = arr(i, 4) ' 型号规格
.Cells(ii, 4).Value = arr(i, 5) ' 单位
.Cells(ii, 5).Value = arr(i, 6) ' 数量
Next
End With
End Sub
Sub CopyDataBasedOnAllMergedCells()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim currentCell As Range
Dim mergedCell As Range
Dim startCell As Range
Dim endCell As Range
Dim startRow As Long
Dim endRow As Long
Dim targetRow As Long
Dim mergeCount As Long '新增变量，用于记录合并单元格的个数
Set wsSource = ThisWorkbook.Sheets("Sheet1") '源工作表，可根据实际修改
Set wsTarget = ThisWorkbook.Sheets("Sheet2") '目标工作表，可根据实际修改
mergeCount = 0 '初始化合并单元格个数为0
'先从B2单元格开始判断
Set currentCell = wsSource.Range("B2")
Do While True
'判断当前单元格是否为合并单元格
If currentCell.MergeCells Then
mergeCount = mergeCount + 1 '找到一个合并单元格，个数加1
Set mergedCell = currentCell.MergeArea
Set startCell = mergedCell.Cells(1)
Set endCell = mergedCell.Cells(mergedCell.Cells.Count)
startRow = startCell.Row
endRow = endCell.Row
targetRow = 3 + (mergeCount - 1) * 22 '根据合并单元格个数计算目标行号
wsSource.Range("C" & startRow & ":F" & endRow).Copy wsTarget.Cells(targetRow, "B")
Set currentCell = endCell.Offset(1) '从当前合并单元格区域的最后一个单元格往下移一个单元格继续判断
Else
If currentCell.Row > wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row Then
Exit Do '如果当前单元格超出了B列有数据的最后一行，结束循环
End If
Set currentCell = currentCell.Offset(1) '如果当前单元格不是合并单元格，往下移一个单元格继续判断
End If
Loop
End Sub
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim currentCell As Range
Dim mergedCell As Range
Dim startCell As Range
Dim endCell As Range
Dim startRow As Long
Dim endRow As Long
Dim targetRow As Long
Dim mergeCount As Long '新增变量，用于记录合并单元格的个数
Set wsSource = ThisWorkbook.Sheets("Sheet1") '源工作表，可根据实际修改
Set wsTarget = ThisWorkbook.Sheets("Sheet2") '目标工作表，可根据实际修改
mergeCount = 0 '初始化合并单元格个数为0
'先从B2单元格开始判断
Set currentCell = wsSource.Range("B2")
Do While True
'判断当前单元格是否为合并单元格
If currentCell.MergeCells Then
mergeCount = mergeCount + 1 '找到一个合并单元格，个数加1
Set mergedCell = currentCell.MergeArea
Set startCell = mergedCell.Cells(1)
Set endCell = mergedCell.Cells(mergedCell.Cells.Count)
startRow = startCell.Row
endRow = endCell.Row
targetRow = 3 + (mergeCount - 1) * 22 '根据合并单元格个数计算目标行号
wsSource.Range("C" & startRow & ":F" & endRow).Copy wsTarget.Cells(targetRow, "B")
Set currentCell = endCell.Offset(1) '从当前合并单元格区域的最后一个单元格往下移一个单元格继续判断
Else
If currentCell.Row > wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row Then
Exit Do '如果当前单元格超出了B列有数据的最后一行，结束循环
End If
Set currentCell = currentCell.Offset(1) '如果当前单元格不是合并单元格，往下移一个单元格继续判断
End If
Loop
End Sub
这玩意都不用学不感兴趣
开通SVIP免广告
