Excel VBAmacros – 提示列描述以断言范围

我已经search了很长时间的答案：

使用下面的代码我想在每组唯一值的末尾input一个空行。 踢球者是，我想它有一个提示，允许用户键入字母的列范围。 我已经尝试了一些它们，不能用查询答案replace“B”。

Dim lRow As Long For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1 If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert Next lRow End Sub 

有什么build议么？

Answer 1

尝试这个

 Sub Demo() Dim lRow As Long Dim sCol As String sCol = InputBox("Enter Column", sCol) For lRow = Cells(Cells.Rows.Count, sCol).End(xlUp).Row To 2 Step -1 If Cells(lRow, sCol) <> Cells(lRow - 1, sCol) Then Rows(lRow).Insert End If Next lRow End Sub 

Answer 2

我想你的问题是，你希望用户能够input“B”，“AA”，“C”作为列？

部分复制@克里斯的代码

 Sub Demo() Dim lRow As Long Dim sCol As String Dim colNum as string sCol = InputBox("Enter Column", sCol) colNum = columns(sCol).column For lRow = Cells(Cells.Rows.Count, colNum ).End(xlUp).Row To 2 Step -1 If Cells(lRow, colNum ) <> Cells(lRow - 1, colNum ) Then Rows(lRow).Insert End If Next lRow End Sub 

Answer 3

尝试Range("B" & Cells.Rows.Count)而不是Cells(Cells.Rows.Count, "B") ，其余类似。

Answer 4

包括打开提示符，这是我最终使用。
将打开的提示连接到一个button，使非技术人员更容易使用：

 Sub InsertRowAtChangeInValue() Dim customerBook As Workbook Dim filter As String Dim caption As String Dim customerFilename As String Dim customerWorkbook As Workbook Dim targetWorkbook As Workbook Set targetWorkbook = Application.ActiveWorkbook filter = "Excel 2007 files (*.xlsx),*.xlsx, Excel 97-03 files (*.xls),*xls, All files (*.*),*.*" caption = "Please select an input file." customerFilename = Application.GetOpenFilename(filter, , caption) Set customerWorkbook = Application.Workbooks.Open(customerFilename) Dim targetSheet As Worksheet Set targetSheet = targetWorkbook.Worksheets(1) Dim sourceSheet As Worksheet Set sourceSheet = customerWorkbook.Worksheets(1) targetSheet.Range("A1", "AR5000").Value = sourceSheet.Range("A1", "AR5000").Value Dim lRow As Long Dim sCol As String Dim colNum As String sCol = InputBox("Enter Column", sCol) colNum = Columns(sCol).Column For lRow = Cells(Cells.Rows.Count, sCol).End(xlUp).Row To 2 Step -1 If Cells(lRow, sCol) <> Cells(lRow - 1, sCol) Then Rows(lRow).Insert End If Next lRow End Sub 

再次感谢您的帮助！