Question

我想创建一个宏，从我的工作簿中复制一个名为“Week”的工作表，删除第一行，添加一个新列（最左边），为其分配标题“Department”并为其分配一个固定值。固定值应该是CSV文件的名称。该名称可以在单元格G6的首页找到。我不希望在第一列中一直复制固定值。我希望它被复制，直到第一列右边的任何列中没有任何值。目前我尝试将其与第二列（B列）进行比较。我收到了消息：

Run-time error '424':

Object required

并且指的是：¨

If InStr(1, thiswork.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then

这是我的代码：

Sub Export_pb_uge()
Dim MyPath As String
Dim MyFileName As String
MyPath = "C:mypath1"
MyFileName = Sheets("Front_Page").Range("g6").Value

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

Sheets("PB_uge").Visible = True

Sheets("PB_uge").Copy
Rows(1).EntireRow.Delete

With target_sheet

    Range("A1").EntireColumn.Insert
    Range("A1").Value = "Department"

End With

If ThisWorkbook.Sheets(ActiveSheet.Name).FilterMode Then ThisWorkbook.Sheets(ActiveSheet.Name).ShowAllData
    lRow = ThisWorkbook.Sheets(ActiveSheet.Name).Cells(Rows.Count, "B").End(xlUp).Row

    For X = 1 To lRow
        If InStr(1, thiswork.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then
            target_sheet.Range("$A$" & X) = ActiveSheet.Name
        End If
    Next

With ActiveWorkbook

    .SaveAs Filename:= _
            MyPath & MyFileName, _
            FileFormat:=xlCSV, _
            CreateBackup:=False, _
            Local:=True

    .Close False
End With

Sheets("Week").Visible = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Answer 1

很好地发现了gazzz0x2z，但是我也会声明并设置target_sheet

Dim target_sheet As Worksheet
Set target_sheet = ActiveSheet ' or for example Sheets("sheet1")

With target_sheet

    Range("A1").EntireColumn.Insert
    Range("A1").Value = "Department"

End With

If ThisWorkbook.Sheets(ActiveSheet.Name).FilterMode Then ThisWorkbook.Sheets (ActiveSheet.Name).ShowAllData
    lRow = ThisWorkbook.Sheets(ActiveSheet.Name).Cells(Rows.Count, "B").End(xlUp).Row

For X = 1 To lRow
    If InStr(1, ThisWorkbook.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then
        target_sheet.Range("$A$" & X) = ActiveSheet.Name
    End If
Next

Answer 2

尝试：

If InStr(1, ThisWorkbook.Sheets(ActiveSheet.Name).Range("$B$" & X), "") > 0 Then

似乎，由于某种原因，你丢失了4封信。

Answer 3

我找到了答案：

private static void startH2(){
    Server tcpServer = null;
    Server webServer = null;
    try {
        tcpServer = Server.createTcpServer("-tcpAllowOthers").start();
        System.out.println("TCP Server Port: " + tcpServer.getPort());
        Class.forName("org.h2.Driver");
        Connection conn = DriverManager.
                getConnection("jdbc:h2:tcp://localhost/~/test22;MODE=PostgreSQL", "sa", "");
        webServer = Server.createWebServer().start();
        System.out.println("Web Server (H2Console) Port: " + webServer.getPort());
    } catch (Exception e) {
        e.printStackTrace();
    }
    System.out.println("finish");
}

将工作表导出为CSV，添加带有标题的新列，并在所有单元格中插入工作簿名称

3 个答案: