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

• #25777 Attila7298 csendes tag

  Új Válasz 2015-03-06 09:27:57 #25777

  Ú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

  

  Attila7298

  csendes tag

  Sziasztok! tudnátok segíteni a megoldásban. Van egy munkalap arról szeretnék a 3,5, 7 oszlop szűrésével adatokat másolni egy másik munkalapra. A gond az hogy nem tudom megoldani hogy ha a keresés lefut az egy sorba tartozok ne külön sorba kerüljenek.
  Sub masolasi()
  Dim i, p, n, sor As Integer 'i-sor, n- sor a Munka2-n

  sor = Worksheets("Idöszakos").Cells(1, 1) 'utolsó sor
  n = 4
  t = Worksheets("Adat szürés").Cells(17, 6) 'kereset szám
  Sheets("Idöszakos").Activate

  For i = 4 To sor
  p = InStr(1, Cells(i, 3).Value, t, vbTextCompare)
  p1 = InStr(1, Cells(i, 5).Value, t, vbTextCompare)
  p2 = InStr(1, Cells(i, 7).Value, t, vbTextCompare)

  If p > 0 Then

  Worksheets("Sz_adat").Cells(n, 7).Value = Cells(i, 2).Value
  Worksheets("Sz_adat").Cells(n, 1).Value = Cells(i, 1).Value
  Worksheets("Sz_adat").Cells(n, 8).Value = Cells(i, 1).Value

  n = n + 1

  End If

  If p1 > 0 Then

  Worksheets("Sz_adat").Cells(n, 9).Value = Cells(i, 4).Value
  Worksheets("Sz_adat").Cells(n, 1).Value = Cells(i, 1).Value
  Worksheets("Sz_adat").Cells(n, 10).Value = Cells(i, 1).Value

  n = n + 1

  End If

  If p2 > 0 Then

  Worksheets("Sz_adat").Cells(n, 11).Value = Cells(i, 6).Value
  Worksheets("Sz_adat").Cells(n, 1).Value = Cells(i, 1).Value
  Worksheets("Sz_adat").Cells(n, 12).Value = Cells(i, 1).Value

  n = n + 1

  End If
  Next i

  End Sub

  ez az eredmény

  Előre köszi minden segítséget

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