daily pastebin goal
59%
SHARE
TWEET

Untitled

a guest Jan 18th, 2019 50 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub LisaaVE()
  2.  
  3. Dim currentRow As Long, lastRow As Long
  4. Dim sh As Worksheet
  5.  
  6. Dim currentRowTilastot As Long, lastRowTilastot As Long
  7.  
  8. Set sh = ActiveSheet
  9.  
  10. currentRowPaikalla = 2
  11.  
  12. lastRowPaikalla = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
  13.  
  14. lastRowTilastot = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
  15.  
  16. ' xCell paikallaolleet
  17. For Each xCell In sh.Range("B2:B" & lastRowPaikalla)
  18.     ' Aloitetaan etsimään riviltä 2
  19.     currentRowTilastot = 2
  20.     ' pCell pelaaja
  21.     For Each pCell In Sheets("Sheet1").Range("A2:A" & lastRowTilastot)
  22.         If pCell.Value = xCell.Value Then
  23.             ' Lisätään pelaajalle +1
  24.             Sheets("Sheet1").Range("D" & currentRowTilastot).Value = Sheets("Sheet1").Range("D" & currentRowTilastot).Value + 1
  25.             Exit For ' Lopetetaan loop
  26.         End If
  27.         currentRowTilastot = currentRowTilastot + 1
  28.     Next pCell
  29.     currentRowPaikalla = currentRowPaikalla + 1
  30. Next xCell
  31.  
  32. Sheets("Sheet1").Range("M2").Value = Sheets("Sheet1").Range("M2").Value + 1
  33.  
  34. End Sub
  35. Sub LisaaOmat()
  36.  
  37. Dim currentRow As Long, lastRow As Long
  38. Dim sh As Worksheet
  39.  
  40. Dim currentRowTilastot As Long, lastRowTilastot As Long
  41.  
  42. Set sh = ActiveSheet
  43.  
  44. currentRowPaikalla = 2
  45.  
  46. lastRowPaikalla = sh.Cells(sh.Rows.Count, "B").End(xlUp).Row
  47.  
  48. lastRowTilastot = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
  49.  
  50. ' xCell paikallaolleet
  51. For Each xCell In sh.Range("B2:B" & lastRowPaikalla)
  52.     ' Aloitetaan etsimään riviltä 2
  53.     currentRowTilastot = 2
  54.     ' pCell pelaaja
  55.     For Each pCell In Sheets("Sheet1").Range("A2:A" & lastRowTilastot)
  56.         If pCell.Value = xCell.Value Then
  57.             ' Lisätään pelaajalle +1
  58.             Sheets("Sheet1").Range("B" & currentRowTilastot).Value = Sheets("Sheet1").Range("B" & currentRowTilastot).Value + 1
  59.             Exit For ' Lopetetaan loop
  60.         End If
  61.         currentRowTilastot = currentRowTilastot + 1
  62.     Next pCell
  63.     currentRowPaikalla = currentRowPaikalla + 1
  64. Next xCell
  65.  
  66. Sheets("Sheet1").Range("L2").Value = Sheets("Sheet1").Range("L2").Value + 1
  67.  
  68. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top