新手求助WPS表格从数组复制到“汇总”工作表

kamavip · 发表于 2024-3-20 18:16

新手对数组复制还有点蒙圈：点击按钮，将录入工作表中的单元格A3至H3和A5至G5单元格这两组从数组复制到“汇总”工作表B2至P2单元格，重新录入后，继续放在B3至P3单元格单元格，以下是代码：

Sub 保存()
Application.ScreenUpdating = False
Dim n As Integer, m As Integer, x As Integer, y As Integer, k As Integer
Dim data() As Variant
Dim i As Integer
Dim rows As Integer
On Error GoTo ErrorHandler
' 检查是否已保存
If Not IsValueInColumn(Sheets("汇总").Range("D:D"), Sheets("录入").Range("C3").Value) Then
MsgBox "尚未保存，准备保存！"
Else
MsgBox "重复已经保存过了"
Exit Sub
End If
' 检查信息是否完整
If Not AllCellsAreFilled() Then
MsgBox "信息不完整，不能保存！"
Exit Sub
End If
' 从“录入”工作表中获取数据
GetDataFromInputSheet data
' 将数据复制到“汇总”工作表
rows = Sheets("汇总").Cells(Sheets("汇总").rows.Count, "B").End(xlUp).Row + 1
CopyDataToSummarySheet data, rows
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "发生错误: " & Err.Description
Application.ScreenUpdating = True
End Sub
' 检查值是否存在于指定列中
Function IsValueInColumn(rng As Range, valueToFind As Variant) As Boolean
Dim cell As Range
For Each cell In rng
If cell.Value = valueToFind Then
IsValueInColumn = True
Exit Function
End If
Next cell
IsValueInColumn = False
End Function
' 检查所有必要的单元格是否都已填写
Function AllCellsAreFilled() As Boolean
Dim cellValues() As Variant
cellValues = Array(Sheets("录入").Range("A3"), Sheets("录入").Range("B3"), Sheets("录入").Range("C3"), _
Sheets("录入").Range("D3"), Sheets("录入").Range("B5"), Sheets("录入").Range("C5"), _
Sheets("录入").Range("D5"), Sheets("录入").Range("G5"))
Dim cell As Variant
For Each cell In cellValues
If cell.Value = "" Then
AllCellsAreFilled = False
Exit Function
End If
Next cell
AllCellsAreFilled = True
End Function
Sub GetDataFromInputSheet(ByRef data() As Variant)
Dim wsInput As Worksheet
Set wsInput = Sheets("录入")
' 假设data是一个8行2列的数组
Dim i As Integer
Dim rowOffset As Integer ' 用于在A列和B列之间跳行的偏移量
' 初始化行偏移量，从A3和B3开始（第3行）
rowOffset = 3
' 填充数组
For i = 1 To 8
' 从A列获取数据
data(i, 1) = wsInput.Cells(rowOffset, "A").Value
' 从B列获取数据
data(i, 2) = wsInput.Cells(rowOffset, "B").Value
' 根据当前的行号更新下一个要读取的行号
' 如果是奇数行，则下一行是偶数行，需要跳过
If rowOffset Mod 2 = 1 Then
rowOffset = rowOffset + 2 ' 跳过一行，移动到下一对行（偶数行）
Else
rowOffset = rowOffset + 1 ' 移动到下一行（仍然是偶数行）
End If
Next i
End Sub
' 将数据从数组复制到“汇总”工作表
Sub CopyDataToSummarySheet(ByRef data() As Variant, ByVal startRow As Integer)
Dim wsSummary As Worksheet
Set wsSummary = Sheets("汇总")
' 从startRow开始，将数据从数组复制到“汇总”工作表
Dim i As Long, j As Long
For i = LBound(data, 1) To UBound(data, 1)
For j = LBound(data, 2) To UBound(data, 2)
wsSummary.Cells(startRow + i - LBound(data, 1), j).Value = data(i, j)
Next j
Next i
End Sub

复制代码

kamavip · 发表于 2024-3-20 18:17

运行时出错，下标越界，新手对数组复制还有点蒙圈。

LIUZHU · 发表于 2024-3-21 09:12

上附件吧，虽然没有看到原始表格内容，但是一个复制，写得够复杂的

kamavip · 发表于 2024-3-21 15:12

LIUZHU 发表于 2024-3-21 09:12
上附件吧，虽然没有看到原始表格内容，但是一个复制，写得够复杂的

传说中的shi山代码，谢谢三楼老大。

LIUZHU · 发表于 2024-3-21 18:00

既然是WPS，用JSA代码简单

LIUZHU · 发表于 2024-3-21 18:00

附件，请审核

LIUZHU · 发表于 2024-3-21 18:06

重复录入的目前是要手工删除，在录入的，当然也可以改成覆盖原来的记录

kamavip · 发表于 2024-3-21 20:56

LIUZHU 发表于 2024-3-21 18:00
附件，请审核

十分谢谢您老大，发现几个小问题，第一个是不会根据发票号码判断是否已经录入重复了，第二个是所有单元格为空时也可录入到汇总表里，

铁马1980 · 发表于 2024-3-22 11:29

第一个把D4改为D3 就可以了，第二个问题应该没问题

kamavip · 发表于 2024-3-25 11:00

LIUZHU 发表于 2024-3-21 18:00
既然是WPS，用JSA代码简单

function 录入(){
Sheets.Item("录入").Activate();
if (Sheets.Item("汇总").Cells.Find(Range("d3").Value2)!=null){
alert(`发票已存在，请检查是否存在重复报销。`);
return;
}
let arr=["=ROW()-1"];
["a3:h3","a5:g5"].forEach(x=>arr.push(...Range(x).Value2[0]));
with(Sheets.Item("汇总")){
let rng=Range("a"+ Rows.Count).End(xlUp);
rng.Offset(1,0).Resize(1,arr.length).Value2=arr;
alert("录入成功。")
}
}
// 定义清除特定单元格内容的函数
function 清除单元() {
Sheets.Item("录入").Range("A3:F3").ClearContents();
Sheets.Item("录入").Range("A5:E5").ClearContents();
alert("指定单元格内容已清除。");
}

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 新手求助WPS表格从数组复制到“汇总”工作表

评分