能够双击多个值并填充列中的多行

时间:2017-06-21 18:39:45

标签: excel vba excel-vba

我有一张主要表格和表单以及一张列出不同代码的单独表格。现在,当我已经在列的第一个单元格(C7)中有代码并且想要双击第二个代码以填充下一行(C8)时,第二个代码将覆盖单元格C7中的第一个代码而不是下降到下一个可用的行,C8。双击单独工作表中的代码后,有没有办法让它进入C列中的下一个可用行,范围C7:C446?

我遇到的问题是,当我尝试在C列中填充多行时,我只能填充第一个单元格C7而不是C7:C446范围内的其他单元格。 这是主表的代码:

Option Explicit
Public sourceRange As Range
Private Sub Worksheet_Change(ByVal Target As Range)
'  If Not Intersect(Target, Range("C7:D446")) Is Nothing Then
      Dim c As Range: Set c = Range("D7:D446")
'     For Each c In Target
 For Each c In c.Cells
          Select Case c.Value
              Case "1000GP", "1000MM", "19FEST", "20IEDU", "20ONLC", "20PART", "20PRDV", "20SPPR", "22DANC", "22LFLC", "22MEDA", "530CCH", "60POUBL", "74GA01", "74GA17", "74GA99", "78REDV"
                  Cells(c.Row, "F").Interior.ColorIndex = 3
              Case Else
                 Cells(c.Row, "F").Interior.ColorIndex = 0
          End Select
      Next c

' End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set sourceRange = Nothing ' Set it to nothing to avoid too long remembering
  If Target.Column = 6 And Target.Cells.Count = 1 And Target.Interior.ColorIndex = 3 Then
      Set sourceRange = Target ' Remember source cell
      'Cancel = True
      Select Case Target.Offset(0, -2).Value2
        Case "1000GP": gotoref1
        Case "1000MM": gotoref2
        Case "19FEST": gotoref3
        Case "20IEDU": gotoref4
        Case "20ONLC": gotoref5
        Case "20PART": gotoref6
        Case "20PRDV": gotoref7
        Case "20SPPR": gotoref8
        Case "22DANC": gotoref9
        Case "22LFLC": gotoref10
        Case "22MEDA": gotoref11
        Case "530CCH": gotoref12
        Case "60PUBL": gotoref13
        Case "74GA01": gotoref14
        Case "74GA17": gotoref15
        Case "74GA99": gotoref16
        Case "78REDV": gotoref17
      End Select
End If

End Sub

以下是包含下列代码的工作表代码。我知道问题是可能的,因为我将代码设置为.Range("C7"),但我尝试.Range("C7:C446),但这不起作用:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column = 1 Then
Worksheets("JE").Range("C7").Value = ActiveCell.Value    
Worksheets("JE").Activate

Cancel = True
End If
End Sub

1 个答案:

答案 0 :(得分:1)

试一试:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column = 1 Then
    For j = 7 to 446
        If Worksheets("JE").Range("C" & j).Value = "" Then
             Worksheets("JE").Range("C" & j).Value = ActiveCell.Value    
             Worksheets("JE").Activate
             Exit For
        End If
     Next j
End If

Cancel = True
End If
End Sub