如何简化红色重复代码，这只是例子，下边还好多重复的，程序已经提示工程太大，求高手

qyzwyc

Private Sub cmd查询_Click()

'铜

  ListView1.ListItems.Clear
  ListView1.ColumnHeaders.Clear

  Dim Itm As ListItem, i As Integer, r As Integer, h As Integer, g As Integer, t As Integer



  With ListView1

            .ColumnHeaders.Add , , "序号", ListView1.Width / 25
            .ColumnHeaders.Add , , "合同号", ListView1.Width / 10, 2
            .ColumnHeaders.Add , , "结算品位", ListView1.Width / 15, 2
            .ColumnHeaders.Add , , "中心品位", ListView1.Width / 15, 2
            .ColumnHeaders.Add , , "冶炼厂品位", ListView1.Width / 15, 2
            .ColumnHeaders.Add , , "结算金属量", ListView1.Width / 12, 1
            .ColumnHeaders.Add , , "中心金属量", ListView1.Width / 12, 1
            .ColumnHeaders.Add , , "冶炼厂金属量", ListView1.Width / 11, 2
            .ColumnHeaders.Add , , "结算与冶炼厂量差", ListView1.Width / 8, 2
            .ColumnHeaders.Add , , "量差比率", ListView1.Width / 15, 2
            .ColumnHeaders.Add , , "财务核销量", ListView1.Width / 12, 1
            .ColumnHeaders.Add , , "冶炼厂调整量", ListView1.Width / 11, 1


     '组合：铜精矿=1，粗铜=2，侯马=3，垣曲=4，已调差合计=5，未调差合计=6


     '123

     If chk铜精矿 = True And chk粗铜 = True And chk侯马 = True And chk垣曲 = False And chk已调差合计 = False And chk未调差合计 = False Then


          For i = 1 To ThisWorkbook.Worksheets.Count
            If Sheets(i).Range("c16") = "侯马" Then
            sss

           End If
         Next

    '124

    ElseIf chk铜精矿 = True And chk粗铜 = True And chk侯马 = False And chk垣曲 = True And chk已调差合计 = False And chk未调差合计 = False Then


          For i = 1 To ThisWorkbook.Worksheets.Count
            If Sheets(i).Range("c16") = "垣曲" Then
            Set Itm = ListView1.ListItems.Add()
     
             Itm.SubItems(1) = Sheets(i).Range("c1")
             Itm.SubItems(2) = Format(Sheets(i).Range("c374"), "##,##0.00%")
             Itm.SubItems(3) = Format(Sheets(i).Range("c480"), "##,##0.00%")
             Itm.SubItems(4) = Format(Sheets(i).Range("c498"), "##,##0.00%")
             Itm.SubItems(5) = Format(WorksheetFunction.Sum(Sheets(i).Range("c452:i452")), "##,##0.000")
             Itm.SubItems(6) = Format(WorksheetFunction.Sum(Sheets(i).Range("c481:i481")), "##,##0.000")
             Itm.SubItems(7) = Format(WorksheetFunction.Sum(Sheets(i).Range("c499:i499")), "##,##0.000")
             Itm.SubItems(8) = Format(WorksheetFunction.Sum(Sheets(i).Range("c523:i523")), "##,##0.000")
             Itm.SubItems(9) = Format(WorksheetFunction.Sum(Sheets(i).Range("j526")), "##,##0.00%")
             Itm.SubItems(10) = Format(WorksheetFunction.Sum(Sheets(i).Range("c525:i525")), "##,##0.000")
             Itm.SubItems(11) = Format(WorksheetFunction.Sum(Sheets(i).Range("c524:i524")), "##,##0.000")

           End If
         Next

     '125

     ElseIf chk铜精矿 = True And chk粗铜 = True And chk侯马 = False And chk垣曲 = False And chk已调差合计 = True And chk未调差合计 = False Then


          For i = 1 To ThisWorkbook.Worksheets.Count
            If Sheets(i).Range("j524") > 0 Then
            Set Itm = ListView1.ListItems.Add()
     
             Itm.SubItems(1) = Sheets(i).Range("c1")
             Itm.SubItems(2) = Format(Sheets(i).Range("c374"), "##,##0.00%")
             Itm.SubItems(3) = Format(Sheets(i).Range("c480"), "##,##0.00%")
             Itm.SubItems(4) = Format(Sheets(i).Range("c498"), "##,##0.00%")
             Itm.SubItems(5) = Format(WorksheetFunction.Sum(Sheets(i).Range("c452:i452")), "##,##0.000")
             Itm.SubItems(6) = Format(WorksheetFunction.Sum(Sheets(i).Range("c481:i481")), "##,##0.000")
             Itm.SubItems(7) = Format(WorksheetFunction.Sum(Sheets(i).Range("c499:i499")), "##,##0.000")
             Itm.SubItems(8) = Format(WorksheetFunction.Sum(Sheets(i).Range("c523:i523")), "##,##0.000")
             Itm.SubItems(9) = Format(WorksheetFunction.Sum(Sheets(i).Range("j526")), "##,##0.00%")
             Itm.SubItems(10) = Format(WorksheetFunction.Sum(Sheets(i).Range("c525:i525")), "##,##0.000")
             Itm.SubItems(11) = Format(WorksheetFunction.Sum(Sheets(i).Range("c524:i524")), "##,##0.000")

           End If
         Next