Excel AND-cmd
=wenn(mittelwert(wenn(0;1;0);wenn(0;1;0))=1;1;0
=wenn(
mittelwert(
wenn(0;1;0);
wenn(0;1;0)
)=1;1;0
Excel CASE-cmd
=wenn(
Summe(
mittelwert(
wenn(und(0;0)=WAHR;1;0);
wenn(und(0;0)=WAHR;1;0)
);
mittelwert(
wenn(und(0;0)=WAHR;1;0);
wenn(und(0;0)=WAHR;1;0)
);
)>1;0;0)
Count rows
Private Sub CommandButton2_Click()
Dim Loletzte As Long
Loletzte = Cells(Rows.Count, 1).End(xlUp).Row + 1
'MsgBox Loletzte - 1
End Sub
Copy Data and move right
Private Sub CommandButton1_Click()
Sheets("Kalkulation_FSP").Range("S9:S26").Copy
Sheets("Testi").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Testi").Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Start").Range("B99").Select
End Sub
Fast delete
Im BOM.vb:
With .Sheets(s_sheet_Direkt)
.Activate()
.Range(.Cells(1, 1), .Cells(2000, 1)).EntireRow.ClearContents()
'Aktive Zelle = A1
.cells(1, 1).select()
'paste from SolidEdge-BOM
.paste()
'Aktive Zelle = A2
.cells(2, 1).select()
End With
call cell pos
ActiveWorkbook.Worksheets(WkzFilenm).Range("C1").End(xlDown).Select
Wkz_tbl_pos = ActiveCell.Address(True, False)
Wkz_tblstring = CStr(Wkz_tbl_pos)
ActiveWorkbook.Worksheets(WkzFilenm).Range("I1").Value = Wkz_tblstring
WkzCord = ActiveWorkbook.Worksheets(WkzFilenm).Range("I1").Value
If Len(WkzCord) = 3 Then
Wkz_tblstring2 = Right(Wkz_tblstring, 1)
Else
Wkz_tblstring2 = Right(Wkz_tblstring, 2)
End If
Wkz_lastrow2 = Wkz_tblstring2
copy marked rows
Private Sub Exportlister_Click()
Dim Loletzte As Long
Dim xZeile As Integer
Dim yreihe As Integer
Dim rowct As Integer
Dim rowct2 As Integer
Dim rowcty As Integer
Dim clval As String
Dim Chkrow As Integer
Dim rowcttarg As Integer
Loletzte = ActiveWorkbook.Sheets("Alle Funktionen").Cells(Rows.Count, 13).End(xlUp).Row + 1
'MsgBox Loletzte - 1
xZeile = 2
yreihe = 1
rowcttarg = 2
rowcty = 13
For rowct2 = 1 To 93
If ActiveWorkbook.Sheets("Alle Funktionen").Cells(xZeile, 13).Value = 1 Then
For rowct = 1 To 11
clval = ActiveWorkbook.Sheets("Alle Funktionen").Cells(xZeile, yreihe).Value
ActiveWorkbook.Sheets("ELCADExport").Cells(rowcttarg, yreihe).Value = clval
'MsgBox (clval & xZeile & yreihe)
yreihe = yreihe + 1
If yreihe = 13 Then
Exit For
End If
Next
rowcttarg = rowcttarg + 1
Else
End If
yreihe = 1
xZeile = xZeile + 1
Next
'MsgBox ("ELCADExport erstellt")
ActiveWorkbook.Sheets("ELCADExport").Activate
End Sub
Filelist (Thanks to Azurous @Software Solutions Online)
Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("\\file\kb\Kundendienst-Projektbezogene_Daten\8154_Lohnarbeiten\211176_SOMA")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.Name
'print file path
Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
End Sub
Folderlist (Thanks to Azurous @Software Solutions Online)
Sub Example2()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFoler = objFSO.GetFolder("\\file\kb\Kundendienst-Projektbezogene_Daten\8154_Lohnarbeiten\211176_SOMA")
i = 1
'loops through each file in the directory and prints their names and path
For Each objSubFolder In objFolder.subfolders
'print folder name
Cells(i + 1, 1) = objSubFolder.Name
'print folder path
Cells(i + 1, 2) = objSubFolder.Path
i = i + 1
Next objSubFolder
End Sub
Pivot Premium
Source: http://www.contextures.com/xlPivotAddIn.html
Free Test-Version from contexture-archive:
