求高手帮忙解决代码

slb_0831

  

1

  通过“收支明细“导入此表          
  

2

  第一列特殊，要换成现在的格式（参照资料表）          
  

3

  “收支明细”中收入是负数的，要导入此表贷方金额，同样，支出是负数的导入借方金额          

slb_0831

没人帮忙？自己顶一下

蓝桥玄霜

请见代码。

slb_0831

非常感谢蓝老师，但还有点问题：就是负数的放到相反方向，不需要合计后放到相反方向.另外，有的数据只取出一个，见图片，如何改？谢谢！

结果

slb_0831

Sub 按钮1_Click()
    Dim DetailArr As Variant, ResultArr() As Variant
    Dim lngrow As Long
    Dim IntCount As Integer, TemNum As Integer
    DetailArr = Worksheets("收支明细").Range("A3").CurrentRegion
    With Worksheets("银行存款日记账")
        .UsedRange.Offset(2, 0).Clear
         For lngrow = LBound(DetailArr) To UBound(DetailArr)
             If DetailArr(lngrow, 7) = .Range("b1").Value And DetailArr(lngrow, 1) = .Range("f1") Then
                 IntCount = IntCount + 1
                 ReDim Preserve ResultArr(1 To 23, 1 To IntCount)
                 ResultArr(1, IntCount) = .Range("p1")
                 ResultArr(2, IntCount) = "RMB|人民币"
                 ResultArr(4, IntCount) = DetailArr(lngrow, 1)
                 ResultArr(5, IntCount) = DetailArr(lngrow, 1)
                 ResultArr(10, IntCount) = DetailArr(lngrow, 5)
                 If DetailArr(lngrow, 8) > 0 Then
                    ResultArr(14, IntCount) = DetailArr(lngrow, 8)
                    ElseIf DetailArr(lngrow, 8) < 0 Then
                    ResultArr(15, IntCount) = DetailArr(lngrow, 8) * -1
                 End If
                 If DetailArr(lngrow, 9) > 0 Then
                    ResultArr(15, IntCount) = DetailArr(lngrow, 9)
                    ElseIf DetailArr(lngrow, 9) < 0 Then
                    ResultArr(14, IntCount) = DetailArr(lngrow, 9) * -1
                 End If
                 ResultArr(16, IntCount) = "1"
                 ResultArr(17, IntCount) = "0"
                 ResultArr(18, IntCount) = "01|公司汇率"
                 ResultArr(21, IntCount) = "0"
             End If
         Next
         If IntCount = 0 Then MsgBox "未查找到符合要求的数据": Exit Sub
        .Range("A3").Resize(IntCount, 23) = Application.WorksheetFunction.Transpose(ResultArr)
   End With
End Sub
网上找的代码，修改了一下，现在唯一的问题是DetailArr(lngrow, 1) = .Range("f1") 直接加month()提示错误，求指教，多谢

风清云也淡

星光老帅你好！
        我在EXCEL HOME 下了你一个文件：函数的方法，附件参考：   108.rar（发表于：15年09月11日，是回复这个问题的：下拉列表中实现模糊查询）；      我改了一下：是用来计算计件工资，很好用！但我发现一个问题就是当：辅助列超过公式中：189行后（公式就会变成，循环引用），我厂有500多个品种，189行不够用。能不能：把辅助列改到有1000行！           盼复：     我Q：157453118