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

• #5060 Cuci3 tag felora:) #5059

  Új Válasz 2009-06-16 22:11:23 #5060

  Ú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

  

  Cuci3

  tag

  válasz felora:) #5059 üzenetére

  Pár kérdés, mivel csak utólag vettem észre, hogy ez a számsor az aláírásod:
  1. Mivel vannak elválasztva a számok a cellán belül? Gondolok itt space-re, vesszőre, tabra, ilyesmire.
  2. Tényleg nyolc szám van? (Aláírásodban csak 7 - bár már magam sem tudom, hogy mit higgyek)

  Kezdésnek itt egy makró, mely a space-sel elválasztott adatokat szedi szét. Az adatoknak a Munka1 A1-es cellájában kell kezdődnie. A 'szövegből oszlopok' módszerrel szétszedett adatokat a Munka2 A2-es cellájától folyamatosan kezdi el felhozni, majd a Munka2 C3-as cellájától kezdve bedob egy kimutatást, amit a számok darabszáma alapján rendez csökkenő sorrendbe.

  Kikommentelni nem volt kedvem, de ha kell egyszer megteszem. Rem OpenOffice alatt is frankón működik, dehát ki tudja. Próbáld ki, aztán majd lesz valahogy!

  Most látom csak, hogy a szöveg szétszedésénél 7 érték van, amit majd módosítani kell, ha tényleg 8 szám van. Próba után okosabbak leszünk.

  Sub nyolcmaximum()
  
  Dim i, sor, sor2 As Integer
  Dim hely, hely2 As String
  
  Munka1.Activate
  Munka1.Cells(1, 1).Select
  Range(Selection, Selection.End(xlDown)).Select
  
  Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
  Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
  :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
  Array(7, 1)), TrailingMinusNumbers:=True
  
  Munka1.Cells(1, 1).Select
  sor = Selection.End(xlDown).Row
  
  For i = 1 To Selection.End(xlToRight).Column
  
  Munka1.Activate
  Munka1.Range(Cells(1, i), Cells(sor, i)).Select
  Selection.Copy
  
  Munka2.Activate
  Munka2.Cells((i - 1) * sor + 2, 1).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Next
  
  Application.CutCopyMode = False
  
  Munka2.Cells(1, 1).Select
  Selection = "szam"
  
  sor2 = Selection.End(xlDown).Row
  hely = "Munka2!R1C1:R" & sor2 & "C1"
  hely2 = "[" & ActiveWorkbook.Name & "]Munka2!R3C3"
  
  Range(Selection, Selection.End(xlDown)).Select
  ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
  hely).CreatePivotTable TableDestination:= _
  hely2, TableName:="nyolcszam", DefaultVersion:= _
  xlPivotTableVersion10
  
  
  ActiveSheet.PivotTables("nyolcszam").AddDataField ActiveSheet.PivotTables( _
  "nyolcszam").PivotFields("szam"), "Darab / szam", xlCount
  ActiveSheet.PivotTables("nyolcszam").AddFields RowFields:="szam"
  ActiveSheet.PivotTables("nyolcszam").PivotFields("szam").AutoSort xlDescending _
  , "Darab / szam"
  
  End Sub

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