asked on
96.18 96.18 96.15 96.15 5620 5/12/2015 13:12
96.175 96.185 96.17 96.18 3904 5/12/2015 13:13
96.15 96.175 96.15 96.17 6790 5/12/2015 13:14
96.16 96.17 96.15 96.15 4803 5/12/2015 13:15
96.14 96.165 96.13 96.16 5560 5/12/2015 13:16
96.12 96.14 96.11 96.14 4051 5/12/2015 13:17
96.105 96.13 96.105 96.12 5312 5/12/2015 13:18
96.06 96.1 96.06 96.1 4202 5/12/2015 13:19
96.08 96.08 96.03 96.05 4969 5/12/2015 13:20
96.09 96.09 96.07 96.0701 1801 5/12/2015 13:21
96.11 96.115 96.09 96.09 7311 5/12/2015 13:22
96.11 96.11 96.11 96.11 1550 5/12/2015 13:23
96.1 96.11 96.09 96.105 9401 5/12/2015 13:24
96.11 96.12 96.09 96.095 3902 5/12/2015 13:25
96.11 96.12 96.1 96.11 3100 5/12/2015 13:26
96.11 96.11 96.1 96.11 4065 5/12/2015 13:27
96.15 96.15 96.1101 96.1101 4917 5/12/2015 13:28
96.14 96.14 96.135 96.14 2000 5/12/2015 13:29
96.11 96.135 96.11 96.13 6704 5/12/2015 13:30
96.11 96.12 96.1 96.11 3100 5/12/2015 13:26
96.11 96.11 96.1 96.11 4065 5/12/2015 13:27
96.15 96.15 96.1101 96.1101 4917 5/12/2015 13:28
96.14 96.14 96.135 96.14 2000 5/12/2015 13:29
96.11 96.135 96.11 96.13 6704 5/12/2015 13:30
96.115 96.13 96.104 96.104 3803 5/12/2015 13:31
96.105 96.12 96.105 96.1138 5170 5/12/2015 13:32
96.12 96.135 96.12 96.12 6859 5/12/2015 13:33
96.14 96.14 96.12 96.121 2650 5/12/2015 13:34
96.12 96.15 96.12 96.14 6507 5/12/2015 13:35
96.13 96.13 96.12 96.12 2200 5/12/2015 13:36
96.095 96.13 96.08 96.13 18145 5/12/2015 13:37
96.1101 96.119 96.085 96.09 6526 5/12/2015 13:38
96.14 96.14 96.115 96.12 4209 5/12/2015 13:39
Sub ImportFile()
Dim fd As FileDialog
Dim strFile As String
Dim FF As Integer
Dim strLine As String
Dim strParts() As String
Dim lngNewRow As Long
Dim intParts As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Filters.Add "Text files", "*.txt"
.Filters.Add "All files", "*.*"
If .Show = -1 Then
strFile = .SelectedItems(1)
Else
MsgBox "Cancel selected"
Exit Sub
End If
End With
Set fd = Nothing
FF = FreeFile
Open strFile For Input As #FF
Do While Not EOF(FF)
Line Input #FF, strLine
strParts = Split(strLine, vbTab)
lngNewRow = lngNewRow + 1
With ActiveSheet
For intParts = 0 To UBound(strParts)
.Cells(lngNewRow, intParts + 1) = strParts(intParts)
Next
End With
Loop
Close
End Sub
Sub RemoveDupes()
Dim lngLastRow As Long
With ActiveSheet
lngLastRow = ActiveSheet.UsedRange.Rows.Count
.Columns("A:F").Select
.Range("A1:F" & lngLastRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6) _
, Header:=xlNo
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("F1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:F" & lngLastRow)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
Sub ConvertToTabDelimited()
Dim TempSht As Worksheet
Dim rRng As Range
Dim sFullPath As String, sName As String
sName = Sheets("Parameters").Range("D9") & Format(Sheets("Data").Range("G8"), " dd mm yy hh") & ".txt"
sFullPath = ThisWorkbook.Path & Application.PathSeparator & sName
With Application
.ScreenUpdating = False
On Error GoTo err_quit
With Sheet2
Set rRng = .Range(.Cells(8, 2), .Cells(.Rows.Count, 7).End(xlUp))
End With
Set TempSht = Sheets.Add
rRng.Copy
TempSht.Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats)
TempSht.Copy
ActiveWorkbook.SaveAs Filename:=sFullPath, FileFormat:=xlText, CreateBackup:=False
.DisplayAlerts = False
TempSht.Delete
ActiveWorkbook.Close True
.DisplayAlerts = True
err_quit:
.ScreenUpdating = True
End With
End Sub
Microsoft Excel topics include formulas, formatting, VBA macros and user-defined functions, and everything else related to the spreadsheet user interface, including error messages.
TRUSTED BY