If Insulator = "PVC" Then
Select Case Core
Case "1C"
For i = 1 To 16
If AreaConductor = ThisWorkbook.Worksheets(1).Cells(i + 7, "A") Then
DK = ThisWorkbook.Worksheets(1).Cells(i + 7, "E")
End If
Exit For
Case "2C"
For i = 1 To 16
If AreaConductor = ThisWorkbook.Worksheets(1).Cells(i + 7, "R") Then
DK = ThisWorkbook.Worksheets(1).Cells(i + 7, "AB")
End If
Exit For
Case "3C"
For i = 1 To 16
If AreaConductor = ThisWorkbook.Worksheets(1).Cells(i + 7, "AI") Then
DK = ThisWorkbook.Worksheets(1).Cells(i + 7, "AS")
End If
Exit For
Case "4C"
For i = 1 To 16
If AreaConductor = ThisWorkbook.Worksheets(1).Cells(i + 7, "AI") Then
DK = ThisWorkbook.Worksheets(1).Cells(i + 7, "BJ")
End If
Exit For
End Select
End If
Function SplitProvince(ByVal Province As String, ByVal delimiter As String) As String
Dim intdem As Integer
Dim intPos As Integer
For intdem = Len(Trim(Province)) To 1 Step -1
If Mid(Province, intdem, 1) = delimiter Then
intPos = intdem
Exit For
End If
Next intdem
SplitProvince = Trim(Right(Province, Len(Province) - intdem))
End FunctionSub test()
Cells(1, 2).Value = SplitProvince((Range("A1").Value), ",")
End SubThì đương nhiên không chạy rồi. Ngoài bảng tính anh Bill có hiểu text là cái giống gì đâu chứ
Function SplitProvince(ByVal Province As String, ByVal delimiter As String) As String
Dim sArr() As String
sArr = Split(Province, delimiter)
SplitProvince = sArr(UBound(sArr, 1))
End FunctionOption Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, n As Long
Dim Arr1(), Arr2(), Arr3(), tmp
On Error Resume Next
If Dic Is Nothing Then Auto_Open
If Not Intersect(Range("C6:C10000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("C6:C10000"), Target)
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
...Sub TestSendEmail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "hoang.xuan@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Arrival Notice" & " " & Range("A2").Value & " " & Range("B2").Value & " " & Range("C2").Value & " " & Range("D2").NumberFormat
.Body = "Please kindly see attached file"
.Attachments.Add (Range("C6").Value & Range("A2").Value & ".pdf")
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox ("ARRIVAL NOTICE IS SENT TO CUSTOMER")
End SubDùng InStrRev như bài 753 gợi ý sẽ tốt hơn
Function SplitProvince(ByVal Province As String, ByVal delimiter As String) As String
Dim sArr() As String
If InStr(1, Province, delimiter, vbTextCompare) Then
sArr = Split(Province, delimiter, , vbTextCompare)
SplitProvince = sArr(UBound(sArr))
End If
End FunctionFunction SplitProvince(ByVal Province As String, ByVal delimiter As String) As String
Dim lPos As Long
lPos = InStrRev(Province, delimiter, , vbTextCompare)
If lPos Then SplitProvince = Trim(Mid(Province, lPos + Len(delimiter)))
End FunctionFunction SplitProvince(ByVal Province As String, ByVal delimiter As String, Optional ByVal CompareMode = vbTextCompare) As String
Dim lPos As Long
lPos = InStrRev(Province, delimiter, , CompareMode)
If lPos Then SplitProvince = Trim(Mid(Province, lPos + Len(delimiter)))
End Function
Bạn thêm đoạn code này vào đầu thủ tục, cái này sẽ làm cho nó không tác động vào sheet1.
if sh is sheet1 then exit subBạn tải code trong video về, và cấu hính như video là chạy được luôn.
Sub Copy_Database()
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Range("A7:Z60000").ClearContents
Dim rngVung As Range
Dim strPath As String
Dim fileName As String
Dim NameFile As String
strPath = Range("H1").Value
fileName = Dir(strPath & "*.xls*")
NameFile = ThisWorkbook.Name
Do While fileName <> ""
Workbooks.Open (strPath & fileName)
ActiveWorkbook.ActiveSheet.Select
If Application.WorksheetFunction.CountA(Range("A2:A60000")) > 0 Then
Range("A2", Range("A60000").End(xlUp).Offset(0, 25)).Copy ' Copy data Each a File
Workbooks(NameFile).Sheets("Database").Range("A60000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues ' Paste vao File tong hop
End If
Application.CutCopyMode = False
ActiveWorkbook.Close SaveChanges:=False
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayAlerts = True
End Sub
