Új hozzászólás Aktív témák

• #9772 Fire/SOUL/CD félisten bozsozso #9716

  Új Válasz 2011-03-26 12:53:57 #9772

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Fire/SOUL/CD

  félisten

  válasz bozsozso #9716 üzenetére

  Bocs a megkésett anyagért, de hétköznapokon el vagyok rendesen foglalva.
  Ez a kód az összes CSV fájlt feldolgozza illetve AutoFilter-rel látja el. Ebből a táblázatból pedig kényelmesen legyárthatsz kimutatást, abban meg azt és úgy összesíthetsz, ahogy csak szeretnéd.
  (Azért tettem be ide PH!-ra, mert hátha mások is találnak benne hasznos dolgokat)

  Private Sub CommandButton1_Click()
  
  'elválasztó-karakter a CSV fájlokon belül
  Const MYDELIMITER = ";"
  'hol találhatóak a CSV fájlok
  Const MYPATH = "D:\fire\csvs_path\"
  'melyik munkalapra legyenek bemásolva az adatok
  '(A munkalapnak LÉTEZNIE KELL!)
  Dim DestWS As Worksheet
  Set DestWS = Worksheets("Munka2")
  'a megadott munkalap melyik cellájától kerüljenek be az adatok
  Dim DestRange As Range
  Set DestRange = DestWS.Range("A1")
  
  Dim MyStr As String
  Dim MyStrs() As String
  Dim MyFileIndex As Integer
  Dim MyRowCount As Integer
  Dim MyCount As Integer
  
  Application.ScreenUpdating = False
  DestWS.Select
  DestWS.UsedRange.Clear
  DestRange.Select
  MyRowCount = 0
  MyFileIndex = 0
  MyFname = Dir(MYPATH & "*.csv")
  Do While Len(MyFname) > 0
  MyFnum = FreeFile
  Open MYPATH & MyFname For Input As MyFnum
  Line Input #MyFnum, MyStr
  Line Input #MyFnum, MyStr
  Line Input #MyFnum, MyStr
  If MyFileIndex = 0 Then
  ActiveCell.Offset(MyRowCount, 0).Value = "TelephelyKód"
  MyFileIndex = 1
  MyStrs = Split(MyStr, MYDELIMITER)
  If Right(MyStr, 1) = MYDELIMITER Then
  MyCount = UBound(MyStrs())
  Else: MyCount = UBound(MyStrs()) + 1
  End If
  For i = 0 To MyCount - 1
  ActiveCell.Offset(MyRowCount, i + 1).Value = MyStrs(i)
  Next i
  MyRowCount = MyRowCount + 1
  End If
  Line Input #MyFnum, MyStr
  Line Input #MyFnum, MyStr
  While Not EOF(MyFnum)
  Line Input #MyFnum, MyStr
  xstr = Mid(MyFname, InStr(1, MyFname, ".", vbTextCompare) - 3, 3)
  ActiveCell.Offset(MyRowCount, 0).Value = xstr
  MyStrs = Split(MyStr, MYDELIMITER)
  For i = 0 To MyCount - 1
  ActiveCell.Offset(MyRowCount, i + 1).Value = Trim(MyStrs(i))
  Next i
  MyRowCount = MyRowCount + 1
  Wend
  Close MyFnum
  MyFname = Dir()
  Loop
  With ActiveSheet
  .Range(DestRange.Address & ":" & Chr(DestRange.Column + MyCount + 64) & DestRange.Row).AutoFilter
  .Columns.AutoFit
  End With
  Application.ScreenUpdating = True
  If MyRowCount = 0 Then MsgBox "A megadott termék nem található az átvizsgált CSV fájlokban.", vbInformation
  Set DestWS = Nothing
  Set DestRange = Nothing
  
  End Sub

Új hozzászólás Aktív témák