作为非专业学习者，为了研究化合物的元素结合分布规律，可以设计数据结构化方案：每一行定位代表化学式的开头元素，每一列定位化学式的其他元素，然后可以让AI生成化学式并放置在对应所在位置，生成csv格式（如AI资源不足，那么不能一次性生成如此大量数据，否则效果很差，替代方案是分批生成，操作118次，提示词参考文末附1）。
不幸的是，数据收集完以后，发现AI对于分列的处理，存在很高概率的放置错误，或分隔符歧义错误，导致数据不能在对应列显示，发生大批量的错位。如果让AI来修正，效果仍然不理想；如果手工去修正，那么处理工作量十分巨大，且难以找到很明确的处理规律（即使撇开化学界规律，文本处理方案也是十分复杂的）；最终设计的方案是让AI生成一套可以让错位数据离散运动的代码，通过不断循环运行代码来让大部分错误“碰”回正确位置。提示词如下：
# 你是一名资深软件开发工程师，请帮我设计VBA代码，代码运行在xlsm的VBE中。
## sheets(1)中有大量数据，操作步骤如下：
1.所有单元格清空颜色。
2.第一行是字段（英文单词，存在大小写），对于第二行开始到最后一行的单元格，如果单元格中的字符包含对应列的字段值（即英文单词，不忽略英文大小写）且字符在和字段值一致的区间后一个字符不能是小写英文字母，那么单元格标记为绿色，否则标记为红色。如果单元格的第一个字母等于所在字段列的第一个字母，且该单元格不在从左上到右下对角线位置（即忽略首行字段行后的所有记录行中，第1行第1列、第2行第2列……，均属于对角线位置）那么单元格优先标记为黄色。
3.对于所有红色单元格和黄色单元格，如果在初始最大列范围内的同一行存在空值，那么随机剪切到同一行任意一个空值单元格中（只允许在同一行内跳跃，且初始数据的最大列范围内）。
4.统计最终绿色、黄色、红色单元格的数量。
5.顺利运行完毕后不要跳出提示框。
Deepseek生成代码：
Option Explicit' 主处理过程Sub ProcessSheetData() Dim ws As Worksheet Dim lastRow As Long, lastCol As Long Dim cell As Range Dim fieldValue As String Dim i As Long, j As Long Dim redYellowCells As Collection Dim greenCount As Long, yellowCount As Long, redCount As Long Dim emptyCellsInRow As Collection Dim targetCell As Range Dim randomIndex As Long Dim cellInfo As Object ' 设置工作表 Set ws = ThisWorkbook.Sheets(1) ' 关闭屏幕更新以提高性能 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ' 步骤1: 清除所有单元格颜色 ws.Cells.Interior.ColorIndex = xlNone ' 获取数据范围 lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' 检查是否有数据 If lastRow < 2 Then ' 恢复设置 Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Exit Sub End If ' 存储需要移动的单元格（红色和黄色） Set redYellowCells = New Collection ' 步骤2: 标记单元格颜色（考虑对角线位置和绿色条件） For i = 2 To lastRow For j = 1 To lastCol Set cell = ws.Cells(i, j) ' 检查单元格是否非空 If Len(Trim(cell.Value)) > 0 Then ' 获取字段值 fieldValue = Trim(ws.Cells(1, j).Value) ' 检查绿色条件：包含字段值且后面字符不能是小写字母 If MeetsGreenCondition(cell.Value, fieldValue) Then cell.Interior.Color = RGB(0, 255, 0) ' 绿色 greenCount = greenCount + 1 Else ' 检查黄色条件：第一个字母匹配且不在对角线上 Dim isDiagonal As Boolean isDiagonal = ((i - 1) = j) If Len(cell.Value) > 0 And Len(fieldValue) > 0 Then If UCase(Left(cell.Value, 1)) = UCase(Left(fieldValue, 1)) And Not isDiagonal Then cell.Interior.Color = RGB(255, 255, 0) ' 黄色 yellowCount = yellowCount + 1 ' 收集黄色单元格信息 Set cellInfo = CreateObject("Scripting.Dictionary") cellInfo.Add "Cell", cell cellInfo.Add "Row", i cellInfo.Add "Value", cell.Value redYellowCells.Add cellInfo Else ' 不满足任何条件，标记为红色 cell.Interior.Color = RGB(255, 0, 0) ' 红色 redCount = redCount + 1 ' 收集红色单元格信息 Set cellInfo = CreateObject("Scripting.Dictionary") cellInfo.Add "Cell", cell cellInfo.Add "Row", i cellInfo.Add "Value", cell.Value redYellowCells.Add cellInfo End If Else ' 字段值或单元格值为空，标记为红色 cell.Interior.Color = RGB(255, 0, 0) ' 红色 redCount = redCount + 1 ' 收集红色单元格信息 Set cellInfo = CreateObject("Scripting.Dictionary") cellInfo.Add "Cell", cell cellInfo.Add "Row", i cellInfo.Add "Value", cell.Value redYellowCells.Add cellInfo End If End If Else ' 空单元格 cell.Interior.ColorIndex = xlNone End If Next j Next i ' 步骤3: 处理红色和黄色单元格的移动 Dim cellsMoved As Long cellsMoved = 0 If redYellowCells.Count > 0 Then ' 初始化随机数生成器 Randomize ' 处理每个红色/黄色单元格 For i = 1 To redYellowCells.Count Set cellInfo = redYellowCells(i) Dim cellRow As Long cellRow = cellInfo("Row") ' 获取同一行的空单元格 Set emptyCellsInRow = New Collection For j = 1 To lastCol If Len(Trim(ws.Cells(cellRow, j).Value)) = 0 Then emptyCellsInRow.Add ws.Cells(cellRow, j) End If Next j ' 如果存在空单元格，则随机移动 If emptyCellsInRow.Count > 0 Then ' 生成随机索引 randomIndex = Int((emptyCellsInRow.Count * Rnd) + 1) Set targetCell = emptyCellsInRow(randomIndex) ' 移动值 targetCell.Value = cellInfo("Value") cellInfo("Cell").Value = "" ' 复制颜色到新位置 targetCell.Interior.Color = cellInfo("Cell").Interior.Color cellInfo("Cell").Interior.ColorIndex = xlNone ' 更新移动计数 cellsMoved = cellsMoved + 1 End If Next i End If ' 步骤4: 统计最终颜色数量（重新计数以确保准确） greenCount = 0 yellowCount = 0 redCount = 0 For i = 2 To lastRow For j = 1 To lastCol Set cell = ws.Cells(i, j) If Len(Trim(cell.Value)) > 0 Then Select Case cell.Interior.Color Case RGB(0, 255, 0) ' 绿色 greenCount = greenCount + 1 Case RGB(255, 255, 0) ' 黄色 yellowCount = yellowCount + 1 Case RGB(255, 0, 0) ' 红色 redCount = redCount + 1 End Select End If Next j Next i ' 在立即窗口输出结果 Debug.Print "处理完成!" Debug.Print "数据范围: 行 " & lastRow & ", 列 " & lastCol Debug.Print "绿色单元格数量: " & greenCount Debug.Print "黄色单元格数量: " & yellowCount Debug.Print "红色单元格数量: " & redCount Debug.Print "移动的单元格数量: " & cellsMoved Debug.Print "总计有值单元格: " & (greenCount + yellowCount + redCount) ' 恢复设置 Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ' 清除对象引用 Set ws = Nothing Set redYellowCells = Nothing Set emptyCellsInRow = NothingEnd Sub' 辅助函数：检查是否满足绿色条件Function MeetsGreenCondition(cellValue As String, fieldValue As String) As Boolean ' 如果字段值为空，不满足绿色条件 If Len(fieldValue) = 0 Then MeetsGreenCondition = False Exit Function End If ' 在单元格值中查找字段值（区分大小写） Dim pos As Long pos = InStr(1, cellValue, fieldValue, vbBinaryCompare) ' 如果没有找到字段值，不满足条件 If pos = 0 Then MeetsGreenCondition = False Exit Function End If ' 检查字段值后面的字符 Dim nextCharPos As Long nextCharPos = pos + Len(fieldValue) ' 如果字段值在字符串末尾，满足条件 If nextCharPos > Len(cellValue) Then MeetsGreenCondition = True Exit Function End If ' 获取字段值后面的字符 Dim nextChar As String nextChar = Mid(cellValue, nextCharPos, 1) ' 检查后面的字符是否是小写字母 ' 如果不是小写字母（a-z），则满足绿色条件 If nextChar < "a" Or nextChar > "z" Then MeetsGreenCondition = True Else MeetsGreenCondition = False End IfEnd Function' 辅助函数：测试绿色条件逻辑Sub TestGreenCondition() Debug.Print "测试绿色条件逻辑:" Debug.Print "字段: 'apple', 单元格: 'apple' -> " & MeetsGreenCondition("apple", "apple") Debug.Print "字段: 'apple', 单元格: 'apple123' -> " & MeetsGreenCondition("apple123", "apple") Debug.Print "字段: 'apple', 单元格: 'apples' -> " & MeetsGreenCondition("apples", "apple") Debug.Print "字段: 'apple', 单元格: 'appleS' -> " & MeetsGreenCondition("appleS", "apple") Debug.Print "字段: 'apple', 单元格: 'myapple' -> " & MeetsGreenCondition("myapple", "apple") Debug.Print "字段: 'apple', 单元格: 'myapples' -> " & MeetsGreenCondition("myapples", "apple") Debug.Print "字段: 'apple', 单元格: 'APPLE' -> " & MeetsGreenCondition("APPLE", "apple") Debug.Print "字段: 'apple', 单元格: 'APPLE123' -> " & MeetsGreenCondition("APPLE123", "apple")End Sub' 辅助函数：显示对角线位置Sub ShowDiagonalPositions() Dim ws As Worksheet Dim lastRow As Long, lastCol As Long Dim i As Long, j As Long Set ws = ThisWorkbook.Sheets(1) lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column Debug.Print "对角线位置 (行-列):" For i = 2 To WorksheetFunction.Min(lastRow, 10) ' 只显示前10行 For j = 1 To WorksheetFunction.Min(lastCol, 10) ' 只显示前10列 If (i - 1) = j Then Debug.Print "行 " & i & ", 列 " & j & ": 是对角线" End If Next j Next iEnd Sub' 辅助函数：仅统计颜色Sub CountColorsOnly() Dim ws As Worksheet Dim lastRow As Long, lastCol As Long Dim cell As Range Dim greenCount As Long, yellowCount As Long, redCount As Long Dim i As Long, j As Long Set ws = ThisWorkbook.Sheets(1) lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column greenCount = 0 yellowCount = 0 redCount = 0 For i = 2 To lastRow For j = 1 To lastCol Set cell = ws.Cells(i, j) If Len(Trim(cell.Value)) > 0 Then Select Case cell.Interior.Color Case RGB(0, 255, 0) ' 绿色 greenCount = greenCount + 1 Case RGB(255, 255, 0) ' 黄色 yellowCount = yellowCount + 1 Case RGB(255, 0, 0) ' 红色 redCount = redCount + 1 End Select End If Next j Next i Debug.Print "当前颜色统计:" Debug.Print "绿色单元格: " & greenCount Debug.Print "黄色单元格: " & yellowCount Debug.Print "红色单元格: " & redCount Debug.Print "总计: " & (greenCount + yellowCount + redCount)End Sub' 主程序入口Sub Main() ' 显示初始信息 Debug.Print "开始处理数据..." Debug.Print "当前时间: " & Now ' 运行主处理过程 ProcessSheetData Debug.Print "处理完成!" Debug.Print "当前时间: " & NowEnd Sub' 清除所有颜色Sub ClearAllColors() ThisWorkbook.Sheets(1).Cells.Interior.ColorIndex = xlNone Debug.Print "已清除所有单元格颜色"End Sub
再将以上代码放入循环之中运行即可。
Sub xunhuan()Application.ScreenUpdating = FalseDim i%For i = 1 To 100 '循环一百次ProcessSheetDataNext iApplication.ScreenUpdating = TrueEnd Sub
以上代码循环200次以上后，虽然运行速度变快，但边际效益急速降低，即“绿化”概率相应变低。设计新的提示词参考如下：
# 你是一名资深软件开发工程师，请帮我设计VBA代码，代码运行在xlsm的VBE中。
## sheets(1)中有大量数据，操作步骤如下：
1.所有非空单元格显示绿色、黄色、红色。
2.绿色单元格不动。对于同一行内的所有红色单元格或黄色单元格，视为一个序列，第一个红色单元格或黄色单元格剪切到同一行的空值中（在初始最大列范围内），第二个的红色单元格或黄色单元格剪切到刚才第一个单元格中（即第一个红色单元格或黄色单元格跳出后留下的单元格），后续以此类推。
3.判断是否绿化：第一行是字段（英文单词，存在大小写），排除字段行以外的单元格，如果根据步骤2变动位置的单元格中的字符包含对应列的字段值（即英文单词，不忽略英文大小写），那么单元格标记为绿色。
4.统计最终绿色、黄色、红色单元格的数量。
5.顺利运行完毕后不要跳出提示框。
似乎随机+非随机交替使用，可以增加碰撞概率。最终匹配率达到97.77%，剩余的是初始值存在复杂性或字符相似性导致识别错误的情况，此仍需要人工排查，不过平均每行排查两个值，已不算多了。
首次运行效果：
最终迭代效果：
附1：化学式生成提示词
# 以下一份元素交叉表，横竖交叉点填写化学式（单质、化合物，可以包含两个以上的元素），并以下分类标准进行注释（类型加括号）。
## 化学式以【金】元素开头（即化学式最左边）。只要输出该行，可能的结果为1*118，同一单元格有多个结果的，用“、”分隔。
## 如果有多个元素（三个及以上），同一化学式可以多次出现在不同列。
## 注意，【】内的元素，必须出现在化学式开头，而不是可以任意调换顺序的。但是，不是为了这种格式强行将元素左移，而是以规范的化学式为优先，如果没有对应的物质，就留空。
## 最终结果输出为csv格式，关于注释内容不要用“,”（英文逗号）来断句。
<交叉表>
中文名 氢 氦 锂 铍 硼 碳 氮 氧 氟 氖 钠 镁 铝 硅 磷 硫 氯 氩 钾 钙 钪 钛 钒 铬 锰 铁 钴 镍 铜 锌 镓 锗 砷 硒 溴 氪 铷 锶 钇 锆 铌 钼 锝 钌 铑 钯 银 镉 铟 锡 锑 碲 碘 氙 铯 钡 镧 铈 镨 钕 钷 钐 铕 钆 铽 镝 钬 铒 铥 镱 镥 铪 钽 钨 铼 锇 铱 铂 金 汞 铊 铅 铋 钋 砹 氡 钫 镭 锕 钍 镤 铀 镎 钚 镅 锔 锫 锎 锿 镄 钔 锘 铹 𬬻 𬭊 𬭳 𬭛 𬭶 鿏 𫟼 𬬭 鿔 鿭 𫓧 镆 𫟷 鿬 鿫
金
</交叉表>
<分类标准>
单质
氧化物
酸
碱
盐
氢化物
配合物
其他二元/多元化合物
烃
烃的衍生物
有机高分子化合物
</分类标准>
