Question

因此，我查看了相同的问题和答案，但这对我的问题没有帮助。

这是代码

    Private Sub Update_To_Search_Click()
 Dim itmx As ListItem
 Set itmx = ListView1.FindItem(Number_Selected.Text, lvwText) ', , lvwPartial)
 If itmx Is Nothing Then
 MsgBox "No Record", vbCritical
 Else
 ListView1.ListItems(itmx.Index).Selected = True
 ListView1.SetFocus
 End If


Dim myindex As Integer
 Number_Selected.Text = Me.ListView1.SelectedItem
 myindex = Me.ListView1.SelectedItem.Index
 TextBox2.Text = Me.ListView1.ListItems.Item(myindex).SubItems(1)
 TextBox3.Text = Me.ListView1.ListItems.Item(myindex).SubItems(2)
 TextBox4.Text = Me.ListView1.ListItems.Item(myindex).SubItems(3)
 TextBox5.Text = Me.ListView1.ListItems.Item(myindex).SubItems(4)
 TextBox6.Text = Me.ListView1.ListItems.Item(myindex).SubItems(5)
 TextBox7.Text = Me.ListView1.ListItems.Item(myindex).SubItems(6)
 TextBox8.Text = Me.ListView1.ListItems.Item(myindex).SubItems(7)
 TextBox9.Text = Me.ListView1.ListItems.Item(myindex).SubItems(8)
 TextBox10.Text = Me.ListView1.ListItems.Item(myindex).SubItems(9)


'Go get the selected line


Dim Base As Worksheet, GoodData As Worksheet
Dim Rng As Range

Set GoodData = Sheets("GoodDBData")
Set Base = Sheets("Data")
Set wb = Workbooks("Staffing LogV1.7.xlsm")
Set listview = wb.Sheets("ListView")
Set fromsearch = wb.Sheets("FromDB")
Set Rng = Base.Range("A20:A28")

    FilePath = CStr(wb.Sheets("Data").Cells(2, "A"))
    filename = "DB.xlsx"
    Application.ScreenUpdating = False
  Set DB = Workbooks.Open(FilePath & "\" & filename)
   Application.ScreenUpdating = True


Rng.Copy
DB.Sheets("Search Criteria").Range("A2").PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

With DB.Sheets("DB")
    With .Rows(1)
    Selection.AutoFilter
    Selection.AutoFilter
    End With
End With


Dim rCrit1 As Range, rCrit2 As Range, rCrit3 As Range, rCrit4 As Range, rCrit5 As Range, rCrit6 As Range, rCrit7 As Range, rCrit8 As Range
Dim rRng1 As Range

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set rCrit1 = Sheets("Search Criteria").Range("A2")
Set rCrit2 = Sheets("Search Criteria").Range("B2")
Set rCrit3 = Sheets("Search Criteria").Range("C2")
Set rCrit4 = Sheets("Search Criteria").Range("D2")
Set rCrit5 = Sheets("Search Criteria").Range("E2")
Set rCrit6 = Sheets("Search Criteria").Range("F2")
Set rCrit7 = Sheets("Search Criteria").Range("G2")
Set rCrit8 = Sheets("Search Criteria").Range("H2")

Set rRng1 = Sheets("DB").Range("A1").CurrentRegion

With rRng1
If rCrit1.Value <> "" Then
    .AutoFilter field:=11, Criteria1:=rCrit1.Value, Operator:=xlOr
End If

If rCrit2.Value <> "" Then
.AutoFilter field:=7, Criteria1:=rCrit2.Value, Operator:=xlOr
End If

If rCrit3.Value <> "" Then
    .AutoFilter field:=13, Criteria1:=rCrit3.Value, Operator:=xlOr
End If

If rCrit4.Value <> "" Then
    .AutoFilter field:=14, Criteria1:=rCrit4.Value, Operator:=xlOr
End If

If rCrit5.Value <> "" Then
    .AutoFilter field:=16, Criteria1:=rCrit5.Value, Operator:=xlOr
End If

If rCrit6.Value <> "" Then
    .AutoFilter field:=30, Criteria1:=rCrit6.Value, Operator:=xlOr
End If

If rCrit7.Value <> "" Then
    .AutoFilter field:=32, Criteria1:=rCrit7.Value, Operator:=xlOr
End If

If rCrit8.Value <> "" Then
    .AutoFilter field:=37, Criteria1:=rCrit8.Value, Operator:=xlOr
End If

End With


Application.EnableEvents = True
Application.ScreenUpdating = True


End sub

以下内容仍然不会复制并粘贴要查找的条件。由于某些原因，它仅复制空白，而没有在Searcriteria中输入数据。 rangeA2。

Rng.Copy
DB.Sheets("Search Criteria").Range("A2").PasteSpecial _
Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

我迷路了，我在寻找我能得到的任何帮助。非常感谢

Answer 1

帮我检查一下

替换您的代码

DeployTask deployTask=new DeployTask();
deployTask.setUrl(url);
deployTask.setUsername("deployer");
deployTask.setPassword("admin");       
deployTask.setLocalWar(warFile.getAbsolutePath());
deployTask.setPath(webPath);
deployTask.execute();

使用

    Base.Select
    Base.Range("A7:A15").Select
    Selection.Copy

    FilePath = CStr(wb.Sheets("Data").Cells(2, "A"))
    FileName = "DB.xlsx"
    Application.ScreenUpdating = False
    Set Db = Workbooks.Open(FilePath & "\" & FileName)
    Application.ScreenUpdating = True

    Sheets("Search Criteria").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("DB").Select
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.AutoFilter

现在尝试吗？

vba代码在f8中运行，但不在f5中运行

1 个答案: