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

• #9691 Fire/SOUL/CD félisten bozsozso #9681

  Új Válasz 2011-03-19 13:08:40 #9691

  Ú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 #9681 üzenetére

  No mindegy, majd kipróbálod, aztán ha valamit módosítani kell, akkor módosítva lesz...

  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
  Dim DestWB As Worksheet
  Set DestWB = Worksheets("Munka2")
  'a megadott munkalap melyik cellájától kerüljenek be az adatok
  Dim DestRange As Range
  Set DestRange = DestWB.Range("A1")
  
  Dim MyStr As String
  Dim MyStrs() As String
  
  'meg kell adni, milyen terméket keressünk a CSV fájlok-ban és OK gomb
  'Cancel gombbal megszakítható a művelet
  UserChange = InputBox("Mit keressünk? (kis- és nagybetű nem számít...)", "Keresés...")
  If Len(UserChange) > 0 Then
  Application.ScreenUpdating = False
  'kiválasszuk a megadott munkalapot
  DestWB.Select
  'töröljük annak teljes tartalmát
  DestWB.UsedRange.Clear
  DestRange.Select
  MyRowCount = 0
  MyFname = Dir(MYPATH & "*.csv")
  Do While Len(MyFname) > 0
  MyFnum = FreeFile
  Open MYPATH & MyFname For Input As MyFnum
  While Not EOF(MyFnum)
  Line Input #MyFnum, MyStr
  MyStrs = Split(MyStr, MYDELIMITER)
  'vizsgáljuk, hogy a CSV fájl adott sorában, utolsó eleme után van-e még elválasztókarakter avagy sem
  If Right(MyStr, 1) = MYDELIMITER Then
  MyCount = UBound(MyStrs())
  Else: MyCount = UBound(MyStrs()) + 1
  End If
  'a MyStrs(0) indexével adjuk meg, hogy a CSV fájlon belül, hányadik elem a termék neve
  'első->0, második->1, harmadik->2 stb stb
  If UCase(MyStrs(0)) = UCase(UserChange) Then
  For i = 0 To MyCount - 1
  ActiveCell.Offset(MyRowCount, i).Value = MyStrs(i)
  Next i
  MyRowCount = MyRowCount + 1
  End If
  Wend
  Close MyFnum
  MyFname = Dir()
  Loop
  Application.ScreenUpdating = True
  'ha nem találtunk egyetlen megadott nevű terméket sem, arról értesítést adunk
  If MyRowCount = 0 Then MsgBox "A megadott termék nem található az átvizsgált CSV fájlokban.", vbInformation
  End If
  
  Set DestWB = Nothing
  Set DestRange = Nothing
  
  End Sub

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