Editor Formating Test

Printable View

07-20-2015, 01:19 PM
DocAElstein

Editor Formating Test and stuff

--General Settings -- Miscellaneous Options -- Message Editor Interface -- . Enhanced Interface - Full WYSIWYG Editing

….in … IE9 browser….. (right mouse click insert ( copied from WORD )<o:p></o:p>
<o:p> </o:p>
X x x x x x x x x x x xx x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x<o:p></o:p>
x x x x x x x x x x x xx x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x xx x x x x x x x<o:p></o:p>
07-20-2015, 01:22 PM
DocAElstein

--General Settings -- Miscellaneous Options -- Message Editor Interface -- . Standard Editor - Extra formatting controls

….in … IE9 browser….. (right mouse click insert ( Copied from WORD ))

X x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x
x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x

Resume On Error GoTo 0 -1 GoTo Error Handling Statements Runtime VBA Error Handling ORNeRe GoRoT N0Nula 1

Hi Ingolf,
. A bit late, and you have a working solution but I caught this as a good chance practice my "Quote in Evaluate String" Stuff. Something I have to practice to get right since I have been struggling a year to understand and still can't quite understand it..
. Anyways, this code alternative, I think will also work for you. _ It gives by me exactly the same results as Rick's, which is a good sign ( and most of these sort of codes I have from his Threads anyways.. )
. Note, you will need to put your zeros in the cell as 0.00 and format it as text for my code to work ( Rick's work's without that , but that is what you would expect!!)…..
. My typical output for a few rows….

Using Excel 2007

_Row\^Col
A

1
1;"BEER";"1";"0.00";"1";"1";"1";"";

2
2;"VODCA";"1";"0.00";"1";"1";"1";"";

3
3;"COGNAC";"1";"0.00";"1";"1";"1";"";

4
4;"WHISKY";"1";"0.00";"1";"1";"1";"";

5
5;"BEER";"1";"0.00";"1";"1";"1";"";

6
6;"VODCA";"1";"0.00";"1";"1";"1";"";

7
7;"COGNAC";"1";"0.00";"1";"1";"1";"";

Sheet2

Code:

Code:

' Sub IngolfBoozeConcatenatingQoutyStuff() 'http://www.excelfox.com/forum/f2/special-concatenation-2042/ 'Worksheet info Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'Sheet Info Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("Sheet2") Dim lr As Long: Let lr = ws1.Cells(Rows.Count, 2).End(xlUp).Row 'The Range Object ( cell ) that is the last cell in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell. +1 gives the next free cell. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lc As Long: Let lc = ws1.Cells.Find(What:="*", After:=ws1.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column 'Get last Row with entry anywhere for Sheet1. Method: You start at last cell then go backwards, effectively starting at last column ( allowing for different XL versions ) searching for anything ( = * ) by columns then get the column number 'Array for string outputs, Redim used as Dim only takes numbers Dim rngA As Range: Set rngA = ws2.Range("A1:A" & lr - 1 & "") 'Output Range rngA.ClearContents 'Just so I know the conctnating lines work!! 'String argument for Evaluate "One Liner Dim Evalstr As String Dim c As Long, r As Long 'Columns, 'Rows in Sheet 'Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, 1), ws1.Cells(lr, 1)).Address & "" & "&"";" & """" & """&" 'DON'T WORK !!! Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, 1), ws1.Cells(lr, 1)).Address & "" & "&"";""""""&" 'Concatenate cell values with ; inbetween For c = 2 To lc - 1 Step 1 ' Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, c), ws1.Cells(lr, c)).Address & "" & "&"""""";""""""&" 'Concatenate cell values with ; inbetween Next c Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, lc), ws1.Cells(lr, lc)).Address & "" & "&"""""";""" 'Concatenate last row ( usually .Address & "" - without any ; Let Evalstr = Replace(Evalstr, "$", "") 'Get rid of $. Not too important here but can help in keeping <255 for longer Strings Let rngA.Value = Evaluate(Evalstr) MsgBox ("I have """"Done" & """" & " It") '!? But why DONT " & """" & " WORK in me Evaluate String like it does in the Msgbox string????? End Sub 'IngolfBoozeConcatenatingQoutyStuff() '

Alan Elston

Dim ilLenDef2 As Integer
Dim llStartLine As Long
Dim llSRow As Long
Dim llSCol As Long
Dim llLine1 As Long
Dim llERow As Long
Dim llECol As Long

Dim llCountLines As Long
Dim ilSanityCheck As Integer
Dim llEndLine As Long

Set olPane = Application.VBE.ActiveCodePane
olPane.GetSelection Startline:=llSRow, startcolumn:=llSCol, Endline:=llERow, Endcolumn:=llECol

slProcName = olPane.CodeModule.ProcOfLine(llSRow, vbext_pk_Proc)
llLine1 = olPane.CodeModule.ProcBodyLine(slProcName, vbext_pk_Proc)
llCountLines = olPane.CodeModule.ProcCountLines(slProcName, vbext_pk_Proc)
llStartLine = olPane.CodeModule.ProcStartLine(slProcName, vbext_pk_Proc)
llEndLine = llStartLine + llCountLines - 1

' Find Dim Line.
llCompLine1 = llLine1

"What's in a String"- VBA break down Loop through character contents of a string

__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf

In VBA coding an

' Find Dim Line. llCompLine1 = llLine1 Do slOLine1 = Trim$(olPane.CodeModule.Lines(llCompLine1, 1)) If Left$(slOLine1, 4) = "Dim " Then Exit Do ElseIf Left$(slOLine1, 6) = "Const " Then

"What's in a String"- VBA break down Loop through character contents of a string

"What's in a String"- VBA break down Loop through character contents of a string

__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an

"What's in a String"- VBA break down Loop through character contents of a string

"What's in a String"- VBA break down Loop through character contents of a string

__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an
"What's in a String"- VBA break down Loop through character contents of a string

__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an
"What's in a String"- VBA break down Loop through character contents of a string

__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an

08-31-2015, 05:06 PM
DocAElstein

Quote:

Originally Posted by snb

Or:

Code:

Sub M_snb() Sheet1.UsedRange.Columns(4).NumberFormat = "0.00" Sheet1.UsedRange.Offset(1).Copy .......

Ahh, interesting that formatting the cell like that works with yoouur "Clipboard method"
. I tried versions of that with mine and fell down - I guess because I am "evaluating stuff" and then so getting a 0. You are copying and pasting.
. But you inspired me to take another look, and got it in the end:

... this bit did the trick:

Code:

'Attempting to get 0.00 format 'ws1.UsedRange.Columns(4).NumberFormat = "0.00" 'Don't Work ws1.Range("D2:D" & lr & "").NumberFormat = "@" ws1.Range("D2:D" & lr & "").Value2 = "0.00"

…………………………………………

Code:

Sub IngolfBoozeConcatenatingQoutyStuff() ' Post #16 http://www.excelfox.com/forum/f2/special-concatenation-2042/ 'Worksheet info Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'Sheet Info Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("Sheet2") Dim lr As Long: Let lr = ws1.Cells(Rows.Count, 2).End(xlUp).Row 'The Range Object ( cell ) that is the last cell in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell. +1 gives the next free cell. ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. ) Dim lc As Long: Let lc = ws1.Cells.Find(What:="*", After:=ws1.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column 'Get last Row with entry anywhere for Sheet1. Method: You start at last cell then go backwards, effectively starting at last column ( allowing for different XL versions ) searching for anything ( = * ) by columns then get the column number 'Range Info Dim rngA As Range: Set rngA = ws2.Range("A1:A" & lr - 1 & "") 'Output Range rngA.ClearContents 'Just so I know the conctnating lines work!! 'Attemping to geet 0.00 format 'ws1.UsedRange.Columns(4).NumberFormat = "0.00" 'Don't Work ws1.Range("D2:D" & lr & "").NumberFormat = "@" ws1.Range("D2:D" & lr & "").Value2 = "0.00" 'String argument for Evaluate "One Liner Dim Evalstr As String Dim c As Long, r As Long 'Columns, 'Rows in Sheet 'Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, 1), ws1.Cells(lr, 1)).Address & "" & "&"";" & """" & """&" 'DON'T WORK !!! Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, 1), ws1.Cells(lr, 1)).Address & "" & "&"";""""""&" 'Concatenate cell values with ; inbetween For c = 2 To lc - 1 Step 1 ' Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, c), ws1.Cells(lr, c)).Address & "" & "&"""""";""""""&" 'Concatenate cell values with ; inbetween Next c Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, lc), ws1.Cells(lr, lc)).Address & "" & "&"""""";""" 'Concatenate last row ( usually .Address & "" - without any ; Let Evalstr = Replace(Evalstr, "$", "") 'Get rid of $. Not too important here but can help in keeping <255 for longer Strings Let rngA.Value = Evaluate(Evalstr) MsgBox ("I have """"Done" & """" & " It") '!? But why DONT " & """" & " WORK in me Evaluate String like it does in the Msgbox string????? End Sub 'IngolfBoozeConcatenatingQoutyStuff()

Thanks for coming back, Snub and encouraging me to get it right, and understand why
Alan
09-01-2015, 07:38 PM
Kyle

Code:

' ' Sub IndexMaker() Rem 1 Arbeitsblätter Info. und Haupt Variablen Dim vTemp As Variant 'Evtl. benutz im Debugging Dim wsIn As Worksheet, wsOutIn As Worksheet 'Dieses variablen definieret als Objekte Arbeitsblätter ( Worksheets) Set wsIn = ThisWorkbook.Worksheets("Index"): Set wsOutIn = ThisWorkbook.Worksheets("Output") 'Gibt die verkürzen Buchstaben im Code Methoden, Eigenschaften usw. von Objekte Arbeitsblätter ( Worksheets) durch Anwendung die .Punkt danach wsIn.Range("A1").CurrentRegion.ClearContents Dim Zelle As Range Dim ZellValue2 As String 'Wann mogliech bemutz variablen für Zelle Werte um zu mimieren wenn AbeitsBlätter ist referenziert, ( bein suche nach Unterstriche muss es, abe für werte nicht Dim lr As Long: Let lr = wsOutIn.Cells(Rows.Count, 2).End(xlUp).Row 'So in Spalte 2 der letzte Bereich (Zelle) hat die End-Eigenschaft (mit Parameter (Argument) Up) angewandt, um einen anderen Bereich (Zelle) zurückzugeben, bzw. die letzte Zelle mit eine Eintrag in ist. Anwendung Die Row Eigenschaft auf diesen Bereich (Zelle) gibt die Zeile Nummer dieses Zelle Rem Verwenden Sie Microsoft Scripting Rintime Dictionary ( Wörterbuch ) um eindeutige Schlüssel referance Worte zu kreigen 'Wir "quasi" stellen also eindeutige Werte in einem Wörterbuch für spätere Nachschlagzwecke: '-erfordert Bibliothek Verweis auf MS Scripting Runtime ( Early Binding ) - 'Extras >> Verweis >> scrolle nach unten und selektieren das Kontrollkästchen neben Microsoft Scripting Runtime ' ..oder Stürzt am nächsten Zeile ' Dim dicOb As Scripting.Dictionary ' Daten hier hat einem eindeutigen "Schlüssel" oder Teilenummer ' Set dicOb = New Scripting.Dictionary 'Die nächsten beiden Zeilen sind eine Alternative genannt Late Bindung . (Beachten Sie aber einige Dictionary Methoden und Eigenschaften werden nicht mit ihm arbeiten - in den Fällen, Early muss verwendet werden. ) Dim dicOb As Object Set dicOb = CreateObject("Scripting.Dictionary") 'Späte Bindung ist besser, wenn man Austausch von Dateien will , so wie ich hier. Early Binding hat den Vorteil, dass Excel Intellisense ' Wird dann für die Microsoft Scripting Runtime Sachen zeigen, nachdem man die .DOT gibt Rem 3 Selection basieret an ausgewählt berisch in wsIn Dim rngSel As Range: 'Set rngSel = wsOutIn.Range("A2:D10") 'Test Bereich ('Bereich soll ausgewählt ab Spalten B With wsOutIn 'Ab hier alles wie .fgfg bedeutet wsIn.fgfg------------------------------------------------ Set rngSel = .Range(.Cells(Selection.Row, Selection.Column), .Cells(Selection.Row + Selection.Rows.Count - 1, Selection.Column + Selection.Columns.Count - 1)) 'Selection Bereich gefunden von eigenschaften Selection Objekt. Diese Objekt hat Info übers Selected Teil von Arbeitsblätter drin Rem Output Arrays Dim arrOutIn() As Variant: Let arrOutIn() = rngSel.Value2 'Wenn die Eigenschaft .Value 2 auf einen Bereich von mehr als 1 Zelle angelegt ist, kehrt ein Kollektion (Array) der meist basis Werte alle Zellen in diesem Bereich zuruck . VBA ermöglicht einen "One -Liner", um dann tu anweisen diese Wert auf einen dynamischen Array . Die Elemente dieser Kollektion werden zunächst als Variante durch VBA definiert. Deswegen mussten wir Dim Elementen als Variant 'Dim arrInOut() As String: ReDim arrInOut(1 To rngSel.Rows.Count, 1 To 2) 'Wir wissen schon große diesem Array und was wir einfühlen wollen,, und es wird gefühlt eine Element nach die andere. Deswegen wir können und dürfen die Passender Dim Typ anweisen schon (Wim musste aber so zu erste machen und dann REDim statt an einfach Dim weil Dim lässt sich nur nummern anweisen, ReDim aber lässt anweisen von variablen Dim arrIndex() As String 'Wir wissen noch nicht große diesem Array aber wissen was wir einfühlen wollen, und es wird gefühlt eine Element nach die andere. Deswegen wir können und dürfen die Passender Dim Typ anweisen schon (Wir musste aber so zu erste machen und dann danach REDim statt an einfach Dim weil Dim lässt sich nur nummern anweisen, ReDim aber lässt anweisen von variablen Rem 4 Haupt Schleife. Baut non Duplikat refferences sowie modificieret Input ( OutIn ) Array um zu zeig wenn Unterstrichen Dim z As Variant, Keys() As Variant 'mit bau von non Duplikat refferences verwenden. Keys wird von anweisen zu eine collection die als Varianten definieret sind. Deswegen, wie beim .Rang.Value mussen wir Typ als Varianten haben Dim j As Long, i As Long, rOffset As Long: Let rOffset = rngSel.Row - 1 For j = 2 To rngSel.Columns.Count 'Für selektieret Bereich außer erste splaten... For i = 1 To rngSel.Rows.Count '... schau alle "rows" 'Dieses Mehtode unter =.Item() einfach Art , die uns eindeutige Schlüssel ohne Vergabe Einträge machen zu mussen http://www.snb-vba.eu/VBA_Dictionary_en.html ' -- Normallerweise .Item() verwendet man, um ein Element von eine eindeutiger Schlüssel, .Item, zu einem vaiable zuweisen, bzw. z = dicLookupTable.Item(x(i)) Wenn der Schlüssel aber nicht existiert, dann wird es gemacht - Cool oder ? --- ( Und kein Wert wird in die Variable angegeben werden ( aber das braucht auch Variable typ Variant) ) If arrOutIn(i, j) <> "" And Right(arrOutIn(i, j), 1) <> "U" Then Let z = dicOb.Item(arrOutIn(i, j)) 'man wäre nichts sehen hier in z: Post #7 # 12 #14 http://www.excelforum.com/excel-programming-vba-macros/1083899-copy-and-paste-entire-row-to-second-sheet-based-on-cell-value.html ' vTemp = .Cells(i, j).Font.Underline'Für Debugging Evtl. If .Cells(i + rOffset, j).Value2 <> "" And .Cells(i + rOffset, j).Font.Underline = 2 Then 'Value 2 ist meist Basiswert und geht schneller, deswegen benutz dieses wenn mogleish arrOutIn(i, j) = arrOutIn(i, j) & "U" 'Modifizieren falls nummer ist unterstrichen Else End If Next i Next j Let Keys() = dicOb.Keys 'Die non Duplikat schlüssel Worte ( Teil Nummer ) ( Unserrere refferences ) can dan von dicOb Eigentschaft bekommen End With ' wsOutIn Rem 5 Scleifen um Output Array ( Index ) zu bauern Dim dI As String, d As Long, stringtemp As String ReDim arrIndex(1 To dicOb.Count, 1 To 2) 'Wir wissen jetzt nummer von Non Duplicat Referrences Keys(d - 1) For d = 1 To dicOb.Count 'Für jede Non Duplicat Referrences.. For j = 2 To rngSel.Columns.Count 'Bau string von alle Element in Input Array für dieses refferrence, For i = 1 To rngSel.Rows.Count If arrOutIn(i, j) = Keys(d - 1) Then stringtemp = stringtemp & arrOutIn(i, 1) & " " If arrOutIn(i, j) = Keys(d - 1) & "U" Then stringtemp = stringtemp & arrOutIn(i, 1) & "U " Next i Next j arrIndex(d, 1) = Keys(d - 1): arrIndex(d, 2) = stringtemp 'Wir habe jetzt die string von verketteten Seite Nummern stringtemp = "" 'Wir wollen diese variablen fürs nächste verketteten Seite Nummern, also soll es jetzt entleeren das wir für diesen Ouput 2row fertig damit sind Next d Let wsIn.Range("a1").Resize(UBound(arrIndex(), 1), UBound(arrIndex(), 2)).Value = arrIndex() ''Einfach weg zu fügen Sie Output Array in einem Linie: Ändern Sie die Größe des Bereichs (Zelle) links oben in dem Ausgangsdaten sollte, zu der Größe der Ausgabe-Array, dann verwenden Sie die zulässige VBA "One -Liner " , um die Werte aus einem Array in eine Tabelle Bereich zuordnen zo können End Sub
09-01-2015, 08:04 PM
DocAElstein

Welcome to The Board Kyle,
. May your extension come out as colorful here as in Other Forums
. Thankyou for Getting it out here for us to play with
Alan

P.s. That's a Geil code you have there

P.s. Wierd to see you decribed as a Member
09-01-2015, 08:19 PM
Kyle

No problem, was a trivial change :), you can update your extension now to get it to work or you can just wait for it to auto update
09-01-2015, 08:24 PM
Kyle

Testing from chrome store:

Code:

Sub test() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim sql As String Rem A full line comment Set cn = New ADODB.Connection 'end of line comment cn.ConnectionString = _ "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MYFILEPATH;Extended Properties='text;HDR=Yes';" cn.Open sql = "Select * FROM " & "[MYFILE.CSV]" 'Something else Set rs = cn.Execute(sql) End Sub
02-02-2016, 05:39 PM
DocAElstein

….in … IE11 browser….. (right mouse click insert ( Copied from WORD ))

X x x x x x x x x x x xx x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x

Font size ( Verdana )

8
9
10
11
12
14
16

_Row\^Col	A
1	1;"BEER";"1";"0.00";"1";"1";"1";"";
2	2;"VODCA";"1";"0.00";"1";"1";"1";"";
3	3;"COGNAC";"1";"0.00";"1";"1";"1";"";
4	4;"WHISKY";"1";"0.00";"1";"1";"1";"";
5	5;"BEER";"1";"0.00";"1";"1";"1";"";
6	6;"VODCA";"1";"0.00";"1";"1";"1";"";
7	7;"COGNAC";"1";"0.00";"1";"1";"1";"";