'----モジュール------ Public Const STILL_ACTIVE As Long = 259 Public Function testThread(ByVal n As Long) As Long Dim i For i = 1 To 10 Sheet1.Cells(1, n) = i DoEvents Next i testThread = 0 End Function '----シート------ Private Sub test_Click() Dim hThd, idThd, dwExCode As Long hThd = CreateThread(0&, 0&, AddressOf testThread, 1, 0&, idThd) Do DoEvents If (GetExitCodeThread(hThd, dwExCode)) Then If (dwExCode <> STILL_ACTIVE) Then Exit Do End If Loop While True CloseHandle hThd End Sub