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

• #8870 Vasinger! nagyúr

  Új Válasz 2014-08-17 22:55:13 #8870

  Ú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

  

  Vasinger!

  nagyúr

  Option Explicit
  
  Sub Frissites()
  Dim sor As Long, usor As Long, WS As Worksheet, WF As WorksheetFunction
  Dim db As Long, db1 As Long, WSS As Worksheet, kezd As Long, vegez As Long
  Dim sor1 As Long
  
  usor = Range("A" & Rows.Count).End(xlUp).Row
  Set WSS = Sheets("Segéd")
  Set WS = Workbooks("kistabla.xlsx").Sheets("Munka1")
  Set WF = Application.WorksheetFunction
  vegez = WF.CountA(WS.Columns(1))
  
  For sor = 1 To usor
  db = WF.CountIf(WS.Columns(2), Cells(sor, 2))
  If db = 0 Then GoTo Tovabb
  Do While db1 < db
  For sor1 = 2 To vegez
  If WS.Cells(sor1, "B") = Cells(sor, "B") Then
  db1 = db1 + 1
  If db1 = 1 Then
  Cells(sor, 1) = "VALID"
  Cells(sor, 3) = WS.Cells(sor1, 3)
  Cells(sor, 4) = WS.Cells(sor1, 4)
  Else
  WSS.Cells(WF.CountA(WSS.Columns(1)) + 1, 1) = "VALID"
  WSS.Cells(WF.CountA(WSS.Columns(2)) + 1, 2) = Cells(sor, 2)
  WSS.Cells(WF.CountA(WSS.Columns(3)) + 1, 3) = WS.Cells(sor1, 3)
  WSS.Cells(WF.CountA(WSS.Columns(4)) + 1, 4) = WS.Cells(sor1, 4)
  End If
  End If
  Next
  Loop
  db1 = 0
  Tovabb:
  Next
  End Sub

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