从列中select状态以填充另一列
我有一个电子表格，每天更新一个在不同破产州（ **text** ）的公司名单。 这些状态可能会有所不同，可以添加新的状态。
macros必须做的是填写公司目前的破产状态column A ，并将其从column B删除。 以下为一个例子：
column A column B **Bankruptcy Required** Company 1 Company 2 Company 3 **Bankruptcy Decreed** Company 4 Company 5 **Extinct Bankruptcy Process** Company 6 **Required Reorganization** Company 9 Company 10 Company 11 **Judicial Recovery Upheld** Company 12 Company 14 Company 15 Company 16
后：
column A column B Bankruptcy Required Company 1 Bankruptcy Required Company 2 Bankruptcy Required Company 3 Bankruptcy Decreed Company 4 Bankruptcy Decreed Company 5 Extinct Bankruptcy Process Company 6 Required Reorganization Company 9 Required Reorganization Company 10 Required Reorganization Company 11 Judicial Recovery Upheld Company 12 Judicial Recovery Upheld Company 14 Judicial Recovery Upheld Company 15 Judicial Recovery Upheld Company 16
有任何想法吗？
遍历行并检查列B中的内容。
Private Sub FixData() Dim ws As Excel.Worksheet Set ws = ActiveWorkbook.Sheets("Sheet2") Dim lastRow As Long Dim szStatus As String Dim lrow As Long lrow = 1 lastRow = ws.Cells(ws.Rows.count, "B").End(xlUp).Row 'Loop through the rows Do While lrow <= lastRow 'Check if the value in column B is bold If ws.Range("B" & lrow).Font.Bold = True Then 'Get the value szStatus = Trim(ws.Range("B" & lrow).Value) 'Delete that row ws.Rows(lrow).EntireRow.Delete Else 'If it does not have ** in it we get to here If ws.Range("B" & lrow).Value <> "" Then 'Write the status we got from the line we deleted into column A. ws.Range("A" & lrow).Value = szStatus End If lrow = lrow + 1 End If Loop End Sub
可能没有VBA，例如添加一个额外的列：
A2中的公式是：
=IFERROR(SEARCH("Bankruptcy",C2),IFERROR(SEARCH("Required",C2),IFERROR(SEARCH("Judicial",C2),)))
在B2中：
=IF(A2>0,C2,B1)
如果将公式转换为公式得出的值，则可以删除不是0的行，然后还可以删除辅助列（ A ）。
我会再试一次，仍然没有VBA。 定义一个名字，如BOLD所示：
=GET.CELL(20,OFFSET(INDIRECT("RC2",FALSE),0,1))
然后inputA2（添加列，作为我的其他答案）：
=BOLD
并将B2公式更改为：
=IF(A2,C2,B1)
然后像以前一样继续删除TRUE行而不是非0行。
也许这可以帮助。
Sub CleanAndTransfer2() Dim ws As Excel.Worksheet Set ws = ActiveWorkbook.Sheets("Sheet1") Dim bankruptcy As String ws.Activate Dim i As Integer i = 2 Do Until IsEmpty(Cells(i, 2)) If Cells(i, 2).Font.Bold = True Then bankruptcy = Cells(i, 2) Rows(i).EntireRow.Delete End If Cells(i, 1) = bankruptcy i = i + 1 Loop End Sub