Question

我对VBA编程很陌生，我已经有一个项目要在我的小公司处理。这是我的问题：

我们从ERP软件导出项目数据，客户希望能够使用公式编辑Excel文件中的数据。

问题是，“项目标题”以某种方式置于“项目位置”之下。我试着在Print Screen中更好地描述它。红盒子展示了“项目标题”

我想上传图片，但我的声誉还不够好（我的第一篇文章）

我会在这里放置一个Imgur链接：http://i.imgur.com/ZKAY5Jz.png

是否有可能使用VBA移动整行？问题是：职位没有明确的数量。因此，有必要使用一些“标记”，例如我在“IST”列中添加的[x]和[ ]。

我希望你能理解我的问题究竟是什么。

Answer 1

如果我理解得当，你想提出一系列项目。

这可能会对您有所帮助（它假设每个项目在第一列上为空，并且数据从第3行开始（在此处可以轻松更改））：< / p>

Sub Faddi()
    Dim FirstDataRow As Integer, _
        LastRow As Integer, _
        RowToCopy As Integer, _
        RowToPaste As Integer

    FirstDataRow = 3

    With ActiveSheet
        LastRow = .Rows(.Rows.Count).End(xlUp).Row
        RowToCopy = .Cells(FirstDataRow, 1).End(xlDown).Row + 1

        'Insert the first row just under headers
        .Rows(RowToCopy).Copy
        .Rows(FirstDataRow).Insert Shift:=xlDown

        'Loop to find each other row to transfer
        Do While RowToCopy <= LastRow
            RowToPaste = RowToCopy
            RowToCopy = .Cells(RowToCopy + 1, 1).End(xlDown).Row + 1
            .Rows(RowToCopy).Copy Destination:=.Rows(RowToPaste)
        Loop
        'Delete last copied row to clean the file
        .Rows(RowToPaste).Delete
    End With
End Sub

Answer 2

谢谢大家的帮助。我为我的问题找到了一个解决方案，似乎效果很好。

Sub Finde_Die_Zelle()
Dim FindString As String
Dim Rng As Range
Dim lastRow As Long
Dim Runs As Long
Runs = 1
FindString = "[x]"
With Sheets("Tabelle1").Range("O:O")
    Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
        Application.Goto Rng, True
    Else
        MsgBox "Fertig 1"
    End If
End With
ActiveCell.Value = "[o]"
ActiveCell.Offset(1).EntireRow.Insert
'ActiveCell.EntireRow.Copy
'Tabelle2.Range("A1").PasteSpecial
lastRow = Tabelle1.Range("F" & Rows.Count).End(xlUp).Row
'Do While Durchlaufe <> lastRow
FindString = "[  ]"
With Sheets("Tabelle1").Range("o:o")
Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
        Application.Goto Rng, True
    Else
        MsgBox "Fertig 2"
    End If
    ActiveCell.Value = "[x]"
    ActiveCell.EntireRow.Copy
End With
FindString = "[o]"
With Sheets("Tabelle1").Range("O:O")
    Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
        Application.Goto Rng, True
    Else
        MsgBox "Fertig 3"
    End If
End With
ActiveCell.Value = ""
ActiveCell.Offset(1).EntireRow.PasteSpecial
Runs = Runs + 1
FindString = "[x]"
With Sheets("Tabelle1").Range("O:O")
    Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
        Application.Goto Rng, True
    Else
        MsgBox "Fertig 4"
    End If
End With
ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
ActiveCell.Value = "[x]"
'Loop
End Sub

我知道它可能看起来不那么专业但这对我有用:) 再次感谢大家的投入

将标题行从下组移动到组之前的行

2 个答案: