Question

我对宏很天真。我在B列中有500行数据。数据是图像文件名，如（X0011@00.jpg，X0021 @ 00.jpg，X0031 @ 00.jpg，X0171 @00.jpg，X0411 @00.jpg）。我想根据下一栏中的条件将每个数据移动到特定的行。

标准必须是找到如下所述的数字：

如果数据是X0011@00.jpg，X00之后的数字1必须移到第1行。

如果数据是X0021@00.jpg，X00之后的数字2必须移到第2行。

如果数据是X0031@00.jpg，X00之后的数字3必须移到第3行。

如果数据是X0131@00.jpg，X0之后的数字13必须移到第13行。

如果数据是X0151@00.jpg，X0之后的数字15必须移到第15行。

如果数据是X0411@00.jpg，X00之后的数字41必须移到第41行。

请参阅下文，我的数据在B栏中的显示方式以及我在C栏中的表现方式。

如果有人能为此提供宏，我感激不尽。

            Col B             Col C
Row1     X0011@00.jpg     X0011@00.jpg
Row2     X0021@00.jpg     X0021@00.jpg
Row3     X0041@00.jpg     
Row4     X0051@00.jpg     X0041@00.jpg
Row5     X0071@00.jpg     X0051@00.jpg
Row6     X0111@00.jpg     
Row7     X0121@00.jpg     X0071@00.jpg
Row8     X0141@00.jpg                 
Row9          
Row10         
Row11                     X0111@00.jpg
Row12                     X0121@00.jpg
Row13                     
Row14                     X0141@00.jpg

由于

Answer 1

这是一个简单的例程，可以完全按照您的要求进行操作。它是如何工作的，对于B列中的每个单元格，我们将行定义为X之后的3位数。然后我们将它来自的单元格的值复制到相应行中的单元格。

Sub PicToRow()
    Dim ws As Worksheet
    Dim picName As String
    Dim picRow As Integer
    Dim picRange As Range

    Set ws = ThisWorkbook.Sheets(1)
    Set picRange = ws.Range("B1", ws.Cells(ws.Rows.Count, "B").End(xlUp))

    For Each myCell In picRange
        If myCell.Value <> "" Then
            picName = Replace(LCase(myCell.Text), "x", "") 'Remove the X
            picRow = CInt(Replace(picName, "1@00.jpg", "")) 'Remove the rest
            ws.Range("C" & picRow).Value = myCell.Value 'Copy data to new cell
        End If
    Next myCell 'do it again
End Sub

Answer 2

Sub justForYou()
Dim i As Integer
With ActiveSheet
For i = 2 To Range("B1000").End(3).Row
    .Cells(i, 3) = Mid(.Cells(i, 2), 2, 3)
    .Cells(i, 3).Copy
    .Cells(i, 3).PasteSpecial xlValues
    .Cells(i, 2).Copy
    .Cells(.Cells(i, 3).Value, 4).PasteSpecial
Next

End With
End Sub

这是一个简单的解决方案。

根据数据

2 个答案: