VBA – 对于循环throuth每行不能工作（我的数据集没有改变）

我有一个大的Excel数据集被清理，在这里我想要logging一个macros来自动执行其中一个步骤。 请看下面的屏幕截图，我想要做的是让程序将名称（列C）下的描述（如果有的话）移动到上面的行F列。 例如，在C3中剪切值并粘贴到F2。

数据集的屏幕截图

我使用每个循环来遍历每一行，但如果我运行我的代码没有任何反应。 我使用countblank（）函数来标识只包含描述的行。 这是我的代码：

Sub ForEach_Loop() Dim ws3 As Worksheet Set ws3 = Worksheets("Sheet3") Dim CutCell As Integer Dim PasteCell As Integer CutCell = 2 PasteCell = 1 Dim Count_Blank As Integer Dim rng As Range Dim row As Range Set rng = ws3.Range("A1:M300") For Each row In rng.Rows Count_Blank = Application.WorksheetFunction.CountBlank(ws3.Range(ws3.Cells(1, CutCell), ws3.Cells(13, CutCell))) If Count_Blank = 12 Then ws3.Range(ws3.Cells(3, CutCell)).Cut ws3.Range(ws3.Cells(6, PasteCell)) End If CutCell = CutCell + 1 PasteCell = PasteCell + 1 Next row End Sub 

我对VBA很新，但是这个工作非常耗时，任何人都可以告诉我代码中的问题是什么？

Answer 1

 Sub ForEach_Loop() Dim ws3 As Worksheet Dim row As Range Set ws3 = Worksheets("Sheet3") For Each row In ws3.Range("A2:M300").Rows If Application.CountA(row) = 1 And row.Cells(3).Value <> "" Then With row.Cells(3) row.Cells(6).Offset(-1, 0).Value = .Value .ClearContents End With End If Next row End Sub