提示下标越界如何解决，谢谢

jixianbin123

xiangbaoan 发表于 2018-8-22 08:04
ReDim brr(8 To UBound(arr), 1 To UBound(arr))'此数组下标是从8开始的，建议改为1
n = n + 1'第一次n为 ...

这是附件，谢谢了

xiangbaoan

jixianbin123 发表于 2018-8-22 19:41
这是附件，谢谢了

'在你的基础上稍微改了一些地方
Sub fyExcelVBA()
Dim arr, brr, crr, i%, j%
Dim m%, n%
Dim o, p, r, s
arr = Sheet11.Range("a10:p" & Sheet11.[d65536].End(3).Row)
ReDim brr(1 To UBound(arr), 1 To 7)
ReDim crr(1 To UBound(arr), 1 To 7)
For i = 1 To UBound(arr)
If arr(i, 4) <> "" Then
     If arr(i, 4) = "安装" Then
         n = n + 1
         brr(n, 1) = arr(i, 1)
         brr(n, 2) = arr(i, 2)
         brr(n, 5) = arr(i, 3)
         brr(n, 6) = arr(i, 6)
         r = arr(i, 15)
         s = arr(i, 16)
         brr(n, 7) = DateSerial(2018, r, s)
      ElseIf arr(i, 4) = "维修" Then
           m = m + 1
          crr(m, 1) = arr(i, 1)
          crr(m, 2) = arr(i, 2)
          crr(m, 5) = arr(i, 3)
          crr(m, 6) = arr(i, 6)
          r = arr(i, 15)
          s = arr(i, 16)
          crr(m, 7) = DateSerial(2018, r, s)
      End If
End If
Next i
Sheets("安装").Range("a3").Resize(UBound(brr), UBound(brr, 2)).ClearContents
Sheets("安装").Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
Sheets("维修").Range("a3").Resize(UBound(crr), UBound(crr, 2)).ClearContents
Sheets("维修").Range("a3").Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub

jixianbin123

xiangbaoan 发表于 2018-8-22 20:15
'在你的基础上稍微改了一些地方
Sub fyExcelVBA()
Dim arr, brr, crr, i%, j%

多谢了，但是如何改的话能使输出到安装或者维修的表格中最后一行？

xiangbaoan

jixianbin123 发表于 2018-8-22 21:05
多谢了，但是如何改的话能使输出到安装或者维修的表格中最后一行？

Sheets("安装").Range("a65536").End(xlUp).Offset(1).Resize(UBound(brr), UBound(brr, 2)) = brr
Sheets("维修").Range("a65536").End(xlUp).Offset(1).Resize(UBound(brr), UBound(brr, 2)) = crr
'不明白你的意思，猜的，不知对否，A2单元格不能为空

jixianbin123

xiangbaoan 发表于 2018-8-22 21:31
Sheets("安装").Range("a65536").End(xlUp).Offset(1).Resize(UBound(brr), UBound(brr, 2)) = brr
Shee ...

英雄所见略同，我也是这样改的，但是又发现一个新的问题，就是原来的表格添加一行数据后，运行宏后，会把原来输出的下方再输出重复的，百思不得其解啊

guozhenzhong_

jixianbin123 发表于 2018-8-22 21:05
多谢了，但是如何改的话能使输出到安装或者维修的表格中最后一行？

Sub fyExcelVBA()
Dim arr, brr, crr, i%, j%
Dim m%, n%
Dim o, p, r, s As String
arr = Sheets("201808").Range("a10:p13")
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))

crr = brr

For i = 1 To UBound(arr)
     If arr(i, 4) = "安装" Then
         n = n + 1
         brr(n, 1) = arr(i, 1)
         brr(n, 2) = arr(i, 2)
         brr(n, 5) = arr(i, 3)
         brr(n, 6) = arr(i, 6)
         r = Format(arr(i, 15), "#")
         s = Format(arr(i, 16), "#")
         crr(n, 7) = DateSerial(2018, r, s)

      ElseIf arr(i, 4) = "维修" Then
           m = m + 1
          crr(m, 1) = arr(i, 1)
          crr(m, 2) = arr(i, 2)
          crr(m, 5) = arr(i, 3)
          crr(m, 6) = arr(i, 6)
          r = Format(arr(i, 15), "#")
          s = Format(arr(i, 16), "#")
          crr(n, 7) = DateSerial(2018, r, s)

      End If
      
Next i
Sheets("安装").Range("a3").Resize(UBound(brr), UBound(brr, 2)).ClearContents
Sheets("安装").Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
Sheets("维修").Range("a3").Resize(UBound(crr), UBound(crr, 2)).ClearContents
Sheets("维修").Range("a3").Resize(UBound(crr), UBound(crr, 2)) = crr


End Sub

jixianbin123

xiangbaoan 发表于 2018-8-22 21:31
Sheets("安装").Range("a65536").End(xlUp).Offset(1).Resize(UBound(brr), UBound(brr, 2)) = brr
Shee ...

英雄所见略同，也是这样改的，但是发现如果在表格中添加一行的话，在安装和维修的表格就会重新在下方输出同样的数据，百思不得解啊

jixianbin123

Sub fyExcelVBA()
Dim arr, brr, crr, i%, j%
Dim m%, n%
Dim o, p, r, s
Set d = CreateObject("scripting.dictionary")
arr = Sheet11.Range("a10:p" & Sheet11.[d65536].End(3).Row)
ReDim brr(1 To UBound(arr), 1 To 7)
For i = 1 To UBound(arr)
     d(arr(i, 1)) = arr(i, 1)
Next
With Worksheets("sheet1")
   If Not d.exists(arr(i, 1).Value) Then
     If arr(i, 4) <> "" Then
          If arr(i, 4) = "安装" Then
              n = n + 1
              brr(n, 1) = arr(i, 1)
              brr(n, 2) = arr(i, 2)
              brr(n, 5) = arr(i, 3)
              brr(n, 6) = arr(i, 6)
              r = arr(i, 15)
              s = arr(i, 16)
              brr(n, 7) = DateSerial(2018, r, s)
           End If
     End If
   End If
End With
Sheets("安装").Range("A" & Sheet1.Range("A65536").End(xlUp).Row + 1).Resize(UBound(brr), UBound(brr, 2)).ClearContents
Sheets("安装").Range("A" & Sheet1.Range("A65536").End(xlUp).Row + 1).Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

--------------------------------------------------
我用这个代码想判断一下第一个表格的数值是否在第二个表格中存在，然后再运行程序，依旧会报下标越界的错误，求大神指导