Excel宏将特定单元格从行转置到列

Question

我正在处理来自图像分析软件的数据，该软件以下列方式导出数据:



在每种情况下，两个空行将图像名称与图像本身的不同注释分开。下一个图像与最后一个注释相隔三个空行。
所有注释都由它们的编号引用，包括一个测量值、它的单位和关于它是哪种测量值的注释。然而，这种配置并不实用。如果数据显示如下，管理数据会容易得多:



以表格的形式，以“Annotation”、“Comment”、“Value”和“Unit”为标题，在同一行中包含有关 annotation 的所有信息。到目前为止，我已经尝试手动转置数据，但是当涉及到许多图像时，这需要很长时间。我还尝试使用宏记录器来自动化该过程，但它不起作用，因为它使用工作表中的固定位置。此外，并非所有图像都具有相同数量的注释。

谁能帮我创建一个宏来做这样的事情？我最近开始涉足 VBA 代码，但这超出了我的范围。

Answer 1

这个宏将完成除了记录之间的行之外的工作，将保留 3 行。要点是记录应该以“图像名称”开头(检查不区分大小写)。您可以稍后对其进行调整以符合要求。

Sub ReorderImageRecords()
Dim cnt As Long, curidx As Long

For i = 1 To ActiveSheet.UsedRange.Rows.Count
 cnt = 0
 If Left(LCase(Cells(i, 1)), 10) = "image name" Then
   Cells(i + 1, 1).EntireRow.Delete
   Cells(i + 1, 1).EntireRow.Delete
   curidx = i
   Cells(curidx + 1, 1) = "Annotation"
   Cells(curidx + 1, 2) = "Comment"
   Cells(curidx + 1, 3) = "Value"
   Cells(curidx + 1, 4) = "Unit"
   While Not IsEmpty(Cells(curidx + cnt + 2, 2))
     cnt = cnt + 1
     Cells(curidx + cnt + 1, 2) = Cells(curidx + cnt + 2, 3)
     Cells(curidx + cnt + 2, 2).EntireRow.Delete
   Wend
   i = i + cnt + 1
 End If
Next i

End Sub

更新

这是一个没有 curidx的优化版本并使用代码删除图像记录之间的多余行:

Sub ReorderImageRecords()
Dim cnt As Long, i As Long

For i = 1 To ActiveSheet.UsedRange.Rows.Count
 cnt = 0
 If i > 1 Then ' If it is not the 1st row
   If Application.CountA(Cells(i - 1, 1).EntireRow) = 0 Then
     Cells(i - 1, 1).EntireRow.Delete ' Delete if the whole preceding row is empty
   End If
   If Application.CountA(Cells(i - 1, 1).EntireRow) = 0 Then
     Cells(i - 1, 1).EntireRow.Delete ' Repeat row removal
   End If
 End If
 If Left(LCase(Cells(i, 1)), 10) = "image name" Then ' We found an image record start
   Cells(i + 1, 1).EntireRow.Delete ' We delete unnecessary blank rows
   Cells(i + 1, 1).EntireRow.Delete ' Repeat removal
   Cells(i + 1, 1) = "Annotation"   ' Insert headers
   Cells(i + 1, 2) = "Comment"
   Cells(i + 1, 3) = "Value"
   Cells(i + 1, 4) = "Unit"
   While Not IsEmpty(Cells(i + cnt + 2, 2)) ' If we are still within one and the same record
     cnt = cnt + 1
     Cells(i + cnt + 1, 2) = Cells(i + cnt + 2, 3) ' Copy comment
     Cells(i + cnt + 2, 2).EntireRow.Delete        ' Remove row with comment
   Wend
   i = i + cnt + 1 ' Increment row index to the current value
 End If
Next i

End Sub