-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Delila_1
veterán
válasz
Attila7298
#25929
üzenetére
Szívesen.

-
Delila_1
veterán
válasz
Attila7298
#25923
üzenetére
Az aljáról haladj felfelé.
For sor= 40 to 1 Step-1
-
azopi74
addikt
válasz
Attila7298
#25777
üzenetére
Szia,
mit is szeretnél pontosan, és mi a gondod?
Azt szeretnéd, hogy ha több feltétel is teljesül (vagyis az "adatszürés" sheet F17 cellájába írt értéket több helyen is megtalálja a 3-ik, 5-ik, és 7-ik oszlop közül, akkor ne ugorjon egy sorral lejjebb minden egyes feltétel kiértékelésnél?
Mert akkor ne léptesd az n-et, minden egyes If - End If statement-ben, csak a végén (ha kell).
Valahogy így:
Sub masolasi2()
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ámSheets("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_adat2").Cells(n, 7).Value = Cells(i, 2).Value
Worksheets("Sz_adat2").Cells(n, 1).Value = Cells(i, 1).Value
Worksheets("Sz_adat2").Cells(n, 8).Value = Cells(i, 1).Value
End If
If p1 > 0 Then
Worksheets("Sz_adat2").Cells(n, 9).Value = Cells(i, 4).Value
Worksheets("Sz_adat2").Cells(n, 1).Value = Cells(i, 1).Value
Worksheets("Sz_adat2").Cells(n, 10).Value = Cells(i, 1).Value
End If
If p2 > 0 Then
Worksheets("Sz_adat2").Cells(n, 11).Value = Cells(i, 6).Value
Worksheets("Sz_adat2").Cells(n, 1).Value = Cells(i, 1).Value
Worksheets("Sz_adat2").Cells(n, 12).Value = Cells(i, 1).Value
End If
If (p > 0) + (p1 > 0) + (p2 > 0) Then
n = n + 1
End If
Next i
End Sub
Új hozzászólás Aktív témák
- ÁRCSÖKKENTÉS Menő retró konfig: Q9550, Gigabyte P43, 4GB RAM, ASUS GT730
- Hibátlan, megkímélt! II Lenovo ThinkPad T540p II i7-4800MQ I GT 730M I 8GB I 240 GB I 15,6" FHD
- Oneplus Nord 2 5G 128GB,Újszerű,Dobozával,12 hónap garanciával
- Apple Watch Series 9 45mm GPS Starlight 1 év Garancia Beszámítás Házhozszállítás
- Gamer PC-Számítógép! Csere-Beszámítás! R5 5500 / RX 6700XT 12GB / 32GB DDR4 / 512GB SSD
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest

Fferi50
