VBA读取另一个excel的内容后根据内容拷贝在另一个excel的数据到本excel

module1

 

Dim file As String

Dim jinengname As String

Dim jinengid As String

Dim xuhuantimes As Integer

Dim kongge As Integer

Dim csjs As String

Dim opentimes As Integer

Dim opentimes1 As Integer

Dim wenjiangeshu As Integer

Private Sub openfile(ByVal Target As Range)

If Target.Row = 1 And Target.Column = 1

Then opennextfile

End If

End Sub

 

Sub opennextfile()

With Application.FileDialog(msoFileDialogOpen)

.Filters.Add "Excel Files", "*.xls, *.xlsx"

If .Show = True Then

FileCount = .SelectedItems.Count

Filename = .SelectedItems(1)

'Range("D2").Value = Filename

file = Filename xuhuantimes = 0 wenjiangeshu = 0 openrealy

End If

End With

End Sub

Sub openrealy()

 Workbooks.Open (file)

  With ActiveWorkbook

Dim i As Integer

For i = 3 To 500

If .Sheets(1).Range("E" & i) = "" Then   

  If .Sheets(1).Range("F" & i) = "" Then  

   Else     

    jinengid = .Sheets(1).Range("H" & i).Value    

     jinengname = .Sheets(1).Range("F" & i).Value     

    xuhuantimes = xuhuantimes + 1      

   Sheet1.Range("Z" & xuhuantimes) = jinengid     

    Sheet1.Range("Y" & xuhuantimes) = jinengname     

    Sheet1.Range("X" & xuhuantimes) = "帐票"      

   Sheet1.Range("W" & xuhuantimes) = .Sheets(1).Range("G" & i).Value

　　'Call openaim(jinengid, jinengname)    

　　End If

Else

　　 jinengid = .Sheets(1).Range("H" & i).Value

　　jinengname = .Sheets(1).Range("E" & i).Value  

   xuhuantimes = xuhuantimes + 1   

    Sheet1.Range("Z" & xuhuantimes) = jinengid      

　　  Sheet1.Range("Y" & xuhuantimes) = jinengname     

   Sheet1.Range("X" & xuhuantimes) = "画面"    

    Sheet1.Range("W" & xuhuantimes) = .Sheets(1).Range("G" & i).Value

　　 'Call openaim(jinengid, jinengname)

End If

Next

'.Close False

  End With

  UserForm1.Show

End Sub

 

UserForm1

 

 

 

Dim wenjiangeshu As Double

Dim ADDCUST As String

Dim NAMES As String

Dim P As String

Dim 仜 As String

Private Sub CommandButton1_Click()

With Application.FileDialog(msoFileDialogOpen)

.Filters.Add "Excel Files", "*.xls, *.xlsx"

If .Show = True Then

FileCount = .SelectedItems.Count

Filename = .SelectedItems(1)

file = Filename

UserForm1.Hide

wenjiangeshu = 0

openfile (file)

End If

End With

End Sub

Sub openfile(ByVal file As String)

Dim NAME As String

Dim NAME1 As String

Dim i As Integer

 Workbooks.Open (file)

With ActiveWorkbook   

  For i = 1 To 421    

  NAME = Sheet1.Range("Z" & i).Value  

  Sheet1.Range("D" & wenjiangeshu + 1) = NAME  

  Sheet1.Range("C" & wenjiangeshu + 1) = Sheet1.Range("X" & i)

   Sheet1.Range("B" & wenjiangeshu + 1) = Sheet1.Range("Y" & i)  

  'Sheet1.Range("I" & wenjiangeshu + 1) = Sheet1.Range("W" & i)  

   For j = 7 To 2000   

　　NAME1 = .Sheets(2).Range("E" & j).Value   

   If Mid(NAME1, 4, 12) = NAME Or Mid(NAME1, 1, 12) = NAME Then  

　　  wenjiangeshu = wenjiangeshu + 1  

  Sheet1.Range("F" & wenjiangeshu) = NAME1   

　　 NAMES = Sheet1.Range("W" & i).Value  

  If .Sheets(2).Range("D" & j).Value <> "" Then  

   If NAMES = "夵" Then   

  ADDCUST = "CUST"   

  P = "P3"  

   仜 = "嘊"  

   End If   

  If NAMES = "怴" Then   

  ADDCUST = "Add"    

P = "P1"   

  仜 = "嘆"  

   End If   

  Sheet1.Range("I" & wenjiangeshu) = ADDCUST    

Sheet1.Range("J" & wenjiangeshu) = P  

   Sheet1.Range("K" & wenjiangeshu) = 仜    

Sheet1.Range("E" & wenjiangeshu) = .Sheets(2).Range("D" & j).Value   

  Sheet1.Range("G" & wenjiangeshu) = .Sheets(2).Range("F" & j).Value    

Sheet1.Range("L" & wenjiangeshu) = .Sheets(2).Range("L" & j).Value   

  Sheet1.Range("M" & wenjiangeshu) = .Sheets(2).Range("M" & j).Value   

  Sheet1.Range("N" & wenjiangeshu) = .Sheets(2).Range("N" & j).Value  

  End If    

        End If

    Next

   Next

End With

End Sub