在VBA中选择特定单元格？

Question

我没有运气就尝试了多个代码。我有一个包含1800行的excel表和以下列：ProgramCode，StudyBoard，FacultyID和ProgramType。 在StudyBoard列中，有一些单元格为空。然后，我将在StudyBoard中找到所有空单元格以及其他列中的相应信息。一旦我找到了所需的单元格，就必须在新的表格中覆盖它们。

我有以下代码，并且无法继续，因为即使我尝试的也不起作用。

Dim ws As Worksheet
Dim StudyBoardCol As Range
Dim PromgramCodeCol As Range
Dim rndCell As Range
Dim foundId As Variant
Dim msg As String
Dim FacultyIdCol As Range
Dim ProgramTypeLetter As Range


Set ws = ThisWorkbook.Worksheets("SSBB")
Set StudyBoardCol = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set ProgramCodeCol = ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
Set FacultyIdCol = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
Set ProgramTypeLetter = ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)

For i = 2 To 1800
    Set rndCell = StudyBoardCol.Cells(Int(Rnd * StudyBoardCol.Cells.Count) + 1)
    FacultyIdCol = Application.Match(rndCell.Value, ProgramCodeCol, 0)
    ProgramTypeLetter = Application.Match(rndCell.Value, ProgramCodeCol, 0)

Answer 1

这应该有效：

    Sub MoveRows()

    Dim ws As Worksheet
        Set ws = Sheets("Sheet1")

    Dim wsTwo As Worksheet
        Set wsTwo = Sheets("Sheet2")

    Dim lastRowWs As Integer
        lastRowWs = ws.Cells(Rows.Count, 1).End(xlUp).Row

    ws.Range("A1:D1").Copy
    wsTwo.Range("A1:D1").PasteSpecial
    Application.CutCopyMode = False

    For rowNum = lastRowWs To 2 Step -1
        If ws.Cells(rowNum, 2) = "" Then
            Dim index As String
                index = "A" & rowNum & ":D" & rowNum
            ws.Range(index).Copy
            wsTwo.Range("A1:D1").Insert
           Application.CutCopyMode = False
        End If
    Next rowNum

End Sub

输入：

输出：

Answer 2

您可以使用SpecialCells“隔离”空白

Dim cell As Range

Dim newSheet As Worksheet 
Set newSheet = Sheets.Add

With ThisWorkbook.WorkSheets("SSBB") ‘reference “SSBB” sheet
    For Each cell in  .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeBlanks) ‘ loop through referenced sheet column A blank cells from row 2 down to last not empty one
        cell.Resize(,3).Copy destination:=newSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1) ‘ copy range next to current cell and paste to newSheet column A first empty cell
   Next
End With