BreadCrumbs: Excel
Excel
From Luke Jackson
(Difference between revisions)
| Revision as of 11:33, 3 May 2008 (edit) Ljackson (Talk | contribs) ← Previous diff |
Revision as of 12:09, 3 May 2008 (edit) Ljackson (Talk | contribs) Next diff → |
||
| Line 1: | Line 1: | ||
| <pre> | <pre> | ||
| - | Sub SplitDemo() | + | Sub RangeDateFix() |
| + | Dim ndate As String | ||
| + | 'ActiveCell.CurrentRegion.Cells.Select | ||
| + | For Each c In ActiveWindow.RangeSelection.Cells | ||
| + | ndate = USdateEU(c.Value) | ||
| + | c.Value = ndate | ||
| + | Next | ||
| + | End Sub | ||
| + | |||
| + | Public Function USdateEU(ByVal tdate As String) | ||
| Dim txt As String, ftxt As String, x As Variant, i As Long | Dim txt As String, ftxt As String, x As Variant, i As Long | ||
| - | txt = ActiveCell.Value | + | txt = tdate |
| x = Split(txt, "/") | x = Split(txt, "/") | ||
| - | For i = 0 To UBound(x) | + | 'For i = 0 To UBound(x) |
| - | MsgBox x(i) | + | 'MsgBox x(i) |
| - | Next i | + | 'Next i |
| ftxt = x(1) & "/" & x(0) & "/" & x(2) | ftxt = x(1) & "/" & x(0) & "/" & x(2) | ||
| - | MsgBox ftxt | + | |
| - | End Sub | + | USdateEU = ftxt |
| + | 'MsgBox ftxt | ||
| + | End Function | ||
| Public Function Split(ByVal sInput As String, _ | Public Function Split(ByVal sInput As String, _ | ||
Revision as of 12:09, 3 May 2008
Sub RangeDateFix()
Dim ndate As String
'ActiveCell.CurrentRegion.Cells.Select
For Each c In ActiveWindow.RangeSelection.Cells
ndate = USdateEU(c.Value)
c.Value = ndate
Next
End Sub
Public Function USdateEU(ByVal tdate As String)
Dim txt As String, ftxt As String, x As Variant, i As Long
txt = tdate
x = Split(txt, "/")
'For i = 0 To UBound(x)
'MsgBox x(i)
'Next i
ftxt = x(1) & "/" & x(0) & "/" & x(2)
USdateEU = ftxt
'MsgBox ftxt
End Function
Public Function Split(ByVal sInput As String, _
Optional ByVal sDelimiter As String, _
Optional ByVal nLimit As Long = -1, _
Optional ByVal bCompare As Integer = vbBinaryCompare _
) As Variant
Dim nCount As Long
Dim nPos As Long
Dim nDelimiterLength As Long
Dim nStart As Long
Dim sOutput() As String
If nLimit = 0 Then
Split = Array()
Else
nDelimiterLength = Len(sDelimiter)
If nDelimiterLength = 0 Then
Split = Array(sInput)
Else
nStart = 1
nPos = InStr(nStart, sInput, sDelimiter, bCompare)
Do While nPos
ReDim Preserve sOutput(0 To nCount) As String
If nCount + 1 = nLimit Then
sOutput(nCount) = Mid(sInput, nStart)
Exit Do
Else
sOutput(nCount) = Mid(sInput, nStart, nPos - nStart)
nStart = nPos + nDelimiterLength
End If
nCount = nCount + 1
nPos = InStr(nStart, sInput, sDelimiter, bCompare)
Loop
ReDim Preserve sOutput(0 To nCount) As String
sOutput(nCount) = Mid(sInput, nStart)
Split = sOutput
End If
End If
End Function