数组保存出现问题

alanlad

Dear
老师们好
我在保存表单表体内容遇到麻烦，请各位帮主看下这个代码如何修改。

感谢！

求助.rar (24.74 KB, 下载次数: 9)

2018-7-25 15:24 上传

点击文件名下载附件

魂断蓝桥

Sub 矩形1_Click()

    Dim ar1(1 To 50, 1 To 6)
    dh = Sheet1.[f2]: Set a = Sheet2.[a:a].Find(dh)
  If Not a Is Nothing Then: MsgBox "该单号已存在，不得重复录入。": Exit Sub '重复单号判断
    With Sheet1
        tt1 = Array(.[f2].Value) '表头数据
        For i1 = 8 To 12 '表体数据
            If Cells(i1, 1) <> "" Then
                M1 = M1 + 1
                ar1(M1, 1) = Sheet1.Cells(i1, 1): ar1(M1, 2) = Sheet1.Cells(i1, 2): ar1(M1, 3) = Sheet1.Cells(i1, 3):
                ar1(M1, 4) = Sheet1.Cells(i1, 4): ar1(M1, 5) = Sheet1.Cells(i1, 5): ar1(M1, 6) = Sheet1.Cells(i1, 6)
            End If
        Next
    End With
    Sheet2.[A65536].End(3).Offset(1).Resize(M1, 1) = tt1
    Sheet2.[b65536].End(3).Offset(1).Resize(M1, 6) = ar1
    MsgBox "保存完毕！"

End Sub

熊之召唤术

AR1数组大小和你选定的区域不一样大

熊之召唤术

熊之召唤术 发表于 2018-7-25 15:39
AR1数组大小和你选定的区域不一样大

Sub 矩形1_Click()
On Error Resume Next
    Dim ar1(1 To 5, 0 To 6)
    dh = Sheet1.[f2]
    Set a = Sheet2.[a:a].Find(dh)
    If Not a Is Nothing Then: MsgBox "该单号已存在，不得重复录入。": Exit Sub '重复单号判断
    With Sheet1
       For i1 = 8 To 12 '表体数据
            M1 = M1 + 1
            If Sheet1.Cells(i1, 1) <> "" Then
                ar1(M1, 0) = Sheet1.[f2]
            Else
                ar1(M1, 0) = ""
            End If
            ar1(M1, 1) = Sheet1.Cells(i1, 1)
            ar1(M1, 2) = Sheet1.Cells(i1, 2)
            ar1(M1, 3) = Sheet1.Cells(i1, 3)
            ar1(M1, 4) = Sheet1.Cells(i1, 4)
            ar1(M1, 5) = Sheet1.Cells(i1, 5)
            ar1(M1, 6) = Sheet1.Cells(i1, 6)
        Next
    End With

    Sheet2.[A65536].End(3).Offset(1).Resize(M1, 7) = ar1

End Sub

lsdongjh

Sub 矩形1_Click()
On Error Resume Next
    Dim ar1(1 To 50, 1 To 6)
    dh = Sheet1.[f2]: Set a = Sheet2.[a:a].Find(dh)
    If Not a Is Nothing Then: MsgBox "该单号已存在，不得重复录入。": Exit Sub '重复单号判断
    With Sheet1
        tt1 = Array(.[f2].Value) '表头数据
        For i1 = 8 To 12 '表体数据
            If Sheet1.Cells(i1, 1) <> "" Then
                M1 = M1 + 1
                    For i2 = 1 To 6
                        ar1(M1, i2) = Sheet1.Cells(i1, i2)
                    Next
            End If
        Next
    End With
    Sheet2.[A65536].End(3).Offset(1).Resize(M1, 1) = tt1
    Sheet2.[b65536].End(3).Offset(1).Resize(UBound(ar1), 6) = ar1
    MsgBox "保存完毕！"

End Sub

alanlad

lsdongjh 发表于 2018-7-25 15:56
Sub 矩形1_Click()
On Error Resume Next
    Dim ar1(1 To 50, 1 To 6)

感谢！好厉害，学习了